Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy non blank cells from 1 sheet to multuiple sheets
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy non blank cells from 1 sheet to multuiple sheets
On Jun 7, 11:23 am, waxback 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy non blank cells from 1 sheet to multuiple sheets
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 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy non blank cells from 1 sheet to multuiple sheets
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 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy non blank cells from 1 sheet to multuiple sheets
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 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy Sheet to new Sheet and clear cells on original sheets | Excel Discussion (Misc queries) | |||
copy a formula down up to blank cells from other sheet | Excel Programming | |||
sheet tabs on multuiple rows | Setting up and Configuration of Excel | |||
Auto "copy and paste" individual cells from various sheets into one sheet ?? | Excel Discussion (Misc queries) | |||
in VBA Sheets("mysheet").Copy Befo=Sheets(1) how do i get a reference to the newly created copy of this sheet? | Excel Worksheet Functions |