Cheers Ryan,
Excellent stuff, managed to get it working with your code, is there a way
for the copy process not to include the formatting from sheet1 ?
Truly appreciated
Regards
Adrian
"ryguy7272" wrote:
> I think this will do what you want:
> Sub newone()
> Dim RngColD As Range
> Dim i As Range
> Dim Dest As Range
> Sheets("Sheet1").Select
> Set RngColD = Range("D1", Range("D" & Rows.count).End(xlUp))
> With Sheets("Sheet2")
> Set Dest = .Range("A1")
> End With
> For Each i In RngColD
> If i.Value = "x" Then
> i.EntireRow.Copy Dest
> Set Dest = Dest.Offset(1)
> End If
> Next i
> End Sub
>
> Change the sheet names to suit your needs.
>
> Regards,
> Ryan---
>
> --
> RyGuy
>
>
> "waxback" wrote:
>
> > Hi Leith,
> >
> > Thanks for the info, i have copy and pasted the macro into the module, but
> > get subscript out of range when i choose to debug it highlights Set MasterWks
> > = Worksheets("Sheet1") yellow, any idea what i'm doing wrong.
> >
> > Regards
> > Waxback
> >
> > "Leith Ross" wrote:
> >
> > > On Jun 7, 11:23 am, waxback <waxb...@discussions.microsoft.com> wrote:
> > > > Help, I have a register on sheet 1 (Master Sheet) containing in column B
> > > > Location which is selected from a list, column C Client Name, column D is
> > > > either blank or contains an X, my problem is i have 4 sheets one for each
> > > > Location, every week the Master sheet is updated and i need the cells
> > > > containing data to be copied into the relevant Location sheets.
> > > >
> > > > example; South Peter
> > > > West Toby X
> > > > North Jenny
> > > > East Steve
> > > > West Donna X
> > > > North Jerry
> > > >
> > > > I need Client in South to be copied over to Sheet South along with the X if
> > > > entered, and i need this in a way that there are no blank rows between the
> > > > clients on each sheet, hope i made the request clear if not i may be able to
> > > > show an example of what i need to do,
> > > >
> > > > Thanks
> > >
> > > Hello waxback,
> > >
> > > This macro will copy the client name and the "X" to the worksheet
> > > whose name in column "B". The macro assumes the Master worksheet
> > > ("Sheet1") starts at row 2. The data is copied over to the other sheet
> > > to columns "A" and "B". You can change these if you need to.
> > >
> > > ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
> > > Sub CopyClients()
> > >
> > > Dim LastEntry As Range
> > > Dim LRCol As New Collection
> > > Dim MasterWks As Worksheet
> > > Dim Wks As Worksheet
> > >
> > > Set MasterWks = Worksheets("Sheet1")
> > >
> > > 'Create a collection of the last row on each worksheet
> > > For Each Wks In Worksheets
> > > With Wks
> > > Set LastEntry = .Cells.Find(What:="*", LookIn:=xlValues,
> > > LookAt:=xlWhole, _
> > > SearchDirection:=xlPrevious,
> > > SearchOrder:=xlRows, _
> > > MatchCase:=False)
> > > If Not LastEntry Is Nothing Then
> > > LRCol.Add LastEntry.Row, Wks.Name
> > > Else
> > > LRCol.Add 1, Wks.Name
> > > End If
> > > End With
> > > Next Wks
> > >
> > > 'Loop through the clients
> > > With MasterWks
> > > For R = 2 To LRCol(.Name)
> > > If .Cells(R, "D") = "X" Then
> > > Set Wks = Worksheets(.Cells(R, "B"))
> > > 'Update the last row
> > > NextRow = LRCol(Wks.Name) + 1
> > > 'Check if the row is beyond the end of the sheet
> > > If NextRow > Wks.Rows.Count Then
> > > MsgBox Wks.Name & " is full."
> > > Exit Sub
> > > End If
> > > 'Update the collection
> > > LRCol.Remove (Wks.Name)
> > > LRCol.Add NextRow, Wks.Name
> > > 'Copy the client to the correct worksheet
> > > .Cells(R, "C").Resize(1, 2).Copy
> > > Destination:=Wks.Cells(NextRow, "A")
> > > End If
> > > Next R
> > > End With
> > >
> > > End Sub
> > > ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
> > >
> > > Sincerely,
> > > Leith Ross
> > >
|
Similar Threads
