If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Help With Macro
I have data all structured in the same way (same column headings) across
multiple sheets within the same workbook. Is there an easy way to concatenate all of the data, without any empty rows, into one summary sheet in the workbook? Thanks in advance. Kevin |
#2
|
|||
|
|||
Help With Macro
What do you mean by concatenate in this context? Do you want the summary
sheet to contain all of the not-empty rows of data from all of the other sheets? Or are you somehow wanting some kind of actual summary of the data on the others? If you do want all data from all other sheets, then the code below should help. Be sure that data is not filtered on any sheets to definitely capture all data. I took the easy way out and assumend that there is at least 1 column that will always have something in it on the sheets on any row that needs to be copied. Since you said all sheets had same format, I think this has a good chance of being true? Sub BuildSummarySheet() 'note that this does not clear existing entries 'from the summary sheet, so multiple runs of 'it will result in replicated entries - you 'should manually clear all previous entries 'before running this code 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'to improve performance Application.ScreenUpdating = False 'begin the actual work For Each anyWS In ThisWorkbook.Worksheets If anyWS.Name summaryWS.Name Then lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow End If ' end test for sheet name matchup Next ' end anyWS loop 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" End Sub "wild turkey no9" wrote: I have data all structured in the same way (same column headings) across multiple sheets within the same workbook. Is there an easy way to concatenate all of the data, without any empty rows, into one summary sheet in the workbook? Thanks in advance. Kevin |
#3
|
|||
|
|||
Help With Macro
Dear JLatham
This is totally awesome. Worked like a charm. A quick explanation of why I'm doing this - using this idea to workaround the limitations of multiple consolidation ranges using pivot tables. Two more favors to ask. Could you add the funcionality to clear all rows on the summary sheet, except for the first, each time the macro is run. As one or more of the sheets may contain pivot tables or other data, can I name the worksheets to include in the row concatenation? Sorry to trouble you with this but I didn't think this through thoroughly before asking my original question. Thanks Kevin "JLatham" wrote: What do you mean by concatenate in this context? Do you want the summary sheet to contain all of the not-empty rows of data from all of the other sheets? Or are you somehow wanting some kind of actual summary of the data on the others? If you do want all data from all other sheets, then the code below should help. Be sure that data is not filtered on any sheets to definitely capture all data. I took the easy way out and assumend that there is at least 1 column that will always have something in it on the sheets on any row that needs to be copied. Since you said all sheets had same format, I think this has a good chance of being true? Sub BuildSummarySheet() 'note that this does not clear existing entries 'from the summary sheet, so multiple runs of 'it will result in replicated entries - you 'should manually clear all previous entries 'before running this code 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'to improve performance Application.ScreenUpdating = False 'begin the actual work For Each anyWS In ThisWorkbook.Worksheets If anyWS.Name summaryWS.Name Then lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow End If ' end test for sheet name matchup Next ' end anyWS loop 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" End Sub "wild turkey no9" wrote: I have data all structured in the same way (same column headings) across multiple sheets within the same workbook. Is there an easy way to concatenate all of the data, without any empty rows, into one summary sheet in the workbook? Thanks in advance. Kevin |
#4
|
|||
|
|||
Help With Macro
That's easy for me to do, adds some work for you. Replace the old code with
that below. You'll still need to make the testCol = "A" change and the change to the name of the summary worksheet. There is now an array called addSheets() that you will have to "fill" with the names of the sheets to be processed. Right now it is set to hold 3 sheet names: Dim addSheets(1 To 3) As String to change the number of sheets to be processed, change the 3 to the total number of them. After making that change add more addSheets(#) = "Sheetname" statements into the code, one for each sheet to be processed. The code also checks to verify that you've typed the sheet names in properly, and if it finds one that isn't quite right, it shows you the entry from the array so you can fix things, and then quits the process. If you encounter those, look for blanks at the beginning or end of the name as typed into the sheet's name tab. That's probably the most common error in matching sheet names. It also deletes old data from the summary sheet before beginning to rebuild the sheet. Here's the new code: Sub BuildSummarySheet() 'JLatham, Excel MVP, 17 APR 2010 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long Dim SLC As Integer 'this array holds the names of the 'sheets that are to be included in 'the processing. ' Change the "To 3" to make it large ' enough to hold all names you need Dim addSheets(1 To 3) As String 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'put the list of sheets to include 'into the array, modify as required 'note that these sheet names MUST be 'spelled and punctuated just like the 'names on those sheet's tabs. 'Case is not important: ' "Sheet1" = "SHEET1", but ' "Sheet1" "Sheet1 " addSheets(1) = "Sheet2" addSheets(2) = "SHEET3" addSheets(3) = "Sheet4" 'this section added to test for valid 'sheet names, and inform you of any 'that can't be found - indicating 'a need to check the name spelling 'in the assignments above On Error Resume Next For SLC = LBound(addSheets) To UBound(addSheets) Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC)) If Err 0 Then Err.Clear MsgBox "Check the name of sheet:" & vbCrLf _ & "[" & addSheets(SLC) & "]" & vbCrLf _ & "No sheet of that exact name found in this workbook", _ vbOKOnly + vbCritical, "Bad Sheet Name - Aborting" On Error GoTo 0 ' clear error trapping GoTo DoHouseCleaning ' exit w/cleanup End If Next ' end SLC loop On Error GoTo 0 ' let system handle errors 'to improve performance Application.ScreenUpdating = False 'delete all but the first row on the summary sheet lastRow = summaryWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then summaryWS.Rows("2:" & lastRow).EntireRow.Delete End If 'begin the actual work For SLC = LBound(addSheets) To UBound(addSheets) Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC)) lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow Next ' end SLC loop MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" DoHouseCleaning: 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing Set anyWS = Nothing End Sub "wild turkey no9" wrote: Dear JLatham This is totally awesome. Worked like a charm. A quick explanation of why I'm doing this - using this idea to workaround the limitations of multiple consolidation ranges using pivot tables. Two more favors to ask. Could you add the funcionality to clear all rows on the summary sheet, except for the first, each time the macro is run. As one or more of the sheets may contain pivot tables or other data, can I name the worksheets to include in the row concatenation? Sorry to trouble you with this but I didn't think this through thoroughly before asking my original question. Thanks Kevin "JLatham" wrote: What do you mean by concatenate in this context? Do you want the summary sheet to contain all of the not-empty rows of data from all of the other sheets? Or are you somehow wanting some kind of actual summary of the data on the others? If you do want all data from all other sheets, then the code below should help. Be sure that data is not filtered on any sheets to definitely capture all data. I took the easy way out and assumend that there is at least 1 column that will always have something in it on the sheets on any row that needs to be copied. Since you said all sheets had same format, I think this has a good chance of being true? Sub BuildSummarySheet() 'note that this does not clear existing entries 'from the summary sheet, so multiple runs of 'it will result in replicated entries - you 'should manually clear all previous entries 'before running this code 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'to improve performance Application.ScreenUpdating = False 'begin the actual work For Each anyWS In ThisWorkbook.Worksheets If anyWS.Name summaryWS.Name Then lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow End If ' end test for sheet name matchup Next ' end anyWS loop 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" End Sub "wild turkey no9" wrote: I have data all structured in the same way (same column headings) across multiple sheets within the same workbook. Is there an easy way to concatenate all of the data, without any empty rows, into one summary sheet in the workbook? Thanks in advance. Kevin |
#5
|
|||
|
|||
Help With Macro
Dear JL
Everything works fine until I enter a formula in one of the concetenated sheets. Somehow the macro thinks there is data in the cell even if it is blank. Did a little research and it looks like it is something to do with using IsEmpty as the test. Tried hacking the code by changing IsEmpty to IsBlank without success. I'm out of my depth here but I feel that a new journey of discovery has begun! It is beyond cheeky for me to ask for any more help but if you can, it would be most appreciated. Thanks Kevin "JLatham" wrote: That's easy for me to do, adds some work for you. Replace the old code with that below. You'll still need to make the testCol = "A" change and the change to the name of the summary worksheet. There is now an array called addSheets() that you will have to "fill" with the names of the sheets to be processed. Right now it is set to hold 3 sheet names: Dim addSheets(1 To 3) As String to change the number of sheets to be processed, change the 3 to the total number of them. After making that change add more addSheets(#) = "Sheetname" statements into the code, one for each sheet to be processed. The code also checks to verify that you've typed the sheet names in properly, and if it finds one that isn't quite right, it shows you the entry from the array so you can fix things, and then quits the process. If you encounter those, look for blanks at the beginning or end of the name as typed into the sheet's name tab. That's probably the most common error in matching sheet names. It also deletes old data from the summary sheet before beginning to rebuild the sheet. Here's the new code: Sub BuildSummarySheet() 'JLatham, Excel MVP, 17 APR 2010 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long Dim SLC As Integer 'this array holds the names of the 'sheets that are to be included in 'the processing. ' Change the "To 3" to make it large ' enough to hold all names you need Dim addSheets(1 To 3) As String 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'put the list of sheets to include 'into the array, modify as required 'note that these sheet names MUST be 'spelled and punctuated just like the 'names on those sheet's tabs. 'Case is not important: ' "Sheet1" = "SHEET1", but ' "Sheet1" "Sheet1 " addSheets(1) = "Sheet2" addSheets(2) = "SHEET3" addSheets(3) = "Sheet4" 'this section added to test for valid 'sheet names, and inform you of any 'that can't be found - indicating 'a need to check the name spelling 'in the assignments above On Error Resume Next For SLC = LBound(addSheets) To UBound(addSheets) Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC)) If Err 0 Then Err.Clear MsgBox "Check the name of sheet:" & vbCrLf _ & "[" & addSheets(SLC) & "]" & vbCrLf _ & "No sheet of that exact name found in this workbook", _ vbOKOnly + vbCritical, "Bad Sheet Name - Aborting" On Error GoTo 0 ' clear error trapping GoTo DoHouseCleaning ' exit w/cleanup End If Next ' end SLC loop On Error GoTo 0 ' let system handle errors 'to improve performance Application.ScreenUpdating = False 'delete all but the first row on the summary sheet lastRow = summaryWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then summaryWS.Rows("2:" & lastRow).EntireRow.Delete End If 'begin the actual work For SLC = LBound(addSheets) To UBound(addSheets) Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC)) lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow Next ' end SLC loop MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" DoHouseCleaning: 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing Set anyWS = Nothing End Sub "wild turkey no9" wrote: Dear JLatham This is totally awesome. Worked like a charm. A quick explanation of why I'm doing this - using this idea to workaround the limitations of multiple consolidation ranges using pivot tables. Two more favors to ask. Could you add the funcionality to clear all rows on the summary sheet, except for the first, each time the macro is run. As one or more of the sheets may contain pivot tables or other data, can I name the worksheets to include in the row concatenation? Sorry to trouble you with this but I didn't think this through thoroughly before asking my original question. Thanks Kevin "JLatham" wrote: What do you mean by concatenate in this context? Do you want the summary sheet to contain all of the not-empty rows of data from all of the other sheets? Or are you somehow wanting some kind of actual summary of the data on the others? If you do want all data from all other sheets, then the code below should help. Be sure that data is not filtered on any sheets to definitely capture all data. I took the easy way out and assumend that there is at least 1 column that will always have something in it on the sheets on any row that needs to be copied. Since you said all sheets had same format, I think this has a good chance of being true? Sub BuildSummarySheet() 'note that this does not clear existing entries 'from the summary sheet, so multiple runs of 'it will result in replicated entries - you 'should manually clear all previous entries 'before running this code 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'to improve performance Application.ScreenUpdating = False 'begin the actual work For Each anyWS In ThisWorkbook.Worksheets If anyWS.Name summaryWS.Name Then lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow End If ' end test for sheet name matchup Next ' end anyWS loop 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" End Sub "wild turkey no9" wrote: I have data all structured in the same way (same column headings) across multiple sheets within the same workbook. Is there an easy way to concatenate all of the data, without any empty rows, into one summary sheet in the workbook? Thanks in advance. Kevin |
#6
|
|||
|
|||
Help With Macro
Dear JL
After further thought the correct test for the cell in column A would be either = 0 or is blank...... "wild turkey no9" wrote: Dear JL Everything works fine until I enter a formula in one of the concetenated sheets. Somehow the macro thinks there is data in the cell even if it is blank. Did a little research and it looks like it is something to do with using IsEmpty as the test. Tried hacking the code by changing IsEmpty to IsBlank without success. I'm out of my depth here but I feel that a new journey of discovery has begun! It is beyond cheeky for me to ask for any more help but if you can, it would be most appreciated. Thanks Kevin "JLatham" wrote: That's easy for me to do, adds some work for you. Replace the old code with that below. You'll still need to make the testCol = "A" change and the change to the name of the summary worksheet. There is now an array called addSheets() that you will have to "fill" with the names of the sheets to be processed. Right now it is set to hold 3 sheet names: Dim addSheets(1 To 3) As String to change the number of sheets to be processed, change the 3 to the total number of them. After making that change add more addSheets(#) = "Sheetname" statements into the code, one for each sheet to be processed. The code also checks to verify that you've typed the sheet names in properly, and if it finds one that isn't quite right, it shows you the entry from the array so you can fix things, and then quits the process. If you encounter those, look for blanks at the beginning or end of the name as typed into the sheet's name tab. That's probably the most common error in matching sheet names. It also deletes old data from the summary sheet before beginning to rebuild the sheet. Here's the new code: Sub BuildSummarySheet() 'JLatham, Excel MVP, 17 APR 2010 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long Dim SLC As Integer 'this array holds the names of the 'sheets that are to be included in 'the processing. ' Change the "To 3" to make it large ' enough to hold all names you need Dim addSheets(1 To 3) As String 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'put the list of sheets to include 'into the array, modify as required 'note that these sheet names MUST be 'spelled and punctuated just like the 'names on those sheet's tabs. 'Case is not important: ' "Sheet1" = "SHEET1", but ' "Sheet1" "Sheet1 " addSheets(1) = "Sheet2" addSheets(2) = "SHEET3" addSheets(3) = "Sheet4" 'this section added to test for valid 'sheet names, and inform you of any 'that can't be found - indicating 'a need to check the name spelling 'in the assignments above On Error Resume Next For SLC = LBound(addSheets) To UBound(addSheets) Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC)) If Err 0 Then Err.Clear MsgBox "Check the name of sheet:" & vbCrLf _ & "[" & addSheets(SLC) & "]" & vbCrLf _ & "No sheet of that exact name found in this workbook", _ vbOKOnly + vbCritical, "Bad Sheet Name - Aborting" On Error GoTo 0 ' clear error trapping GoTo DoHouseCleaning ' exit w/cleanup End If Next ' end SLC loop On Error GoTo 0 ' let system handle errors 'to improve performance Application.ScreenUpdating = False 'delete all but the first row on the summary sheet lastRow = summaryWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then summaryWS.Rows("2:" & lastRow).EntireRow.Delete End If 'begin the actual work For SLC = LBound(addSheets) To UBound(addSheets) Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC)) lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow Next ' end SLC loop MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" DoHouseCleaning: 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing Set anyWS = Nothing End Sub "wild turkey no9" wrote: Dear JLatham This is totally awesome. Worked like a charm. A quick explanation of why I'm doing this - using this idea to workaround the limitations of multiple consolidation ranges using pivot tables. Two more favors to ask. Could you add the funcionality to clear all rows on the summary sheet, except for the first, each time the macro is run. As one or more of the sheets may contain pivot tables or other data, can I name the worksheets to include in the row concatenation? Sorry to trouble you with this but I didn't think this through thoroughly before asking my original question. Thanks Kevin "JLatham" wrote: What do you mean by concatenate in this context? Do you want the summary sheet to contain all of the not-empty rows of data from all of the other sheets? Or are you somehow wanting some kind of actual summary of the data on the others? If you do want all data from all other sheets, then the code below should help. Be sure that data is not filtered on any sheets to definitely capture all data. I took the easy way out and assumend that there is at least 1 column that will always have something in it on the sheets on any row that needs to be copied. Since you said all sheets had same format, I think this has a good chance of being true? Sub BuildSummarySheet() 'note that this does not clear existing entries 'from the summary sheet, so multiple runs of 'it will result in replicated entries - you 'should manually clear all previous entries 'before running this code 'this all depends on there being one 'column that will always have data in it 'on any row that has data change this 'Const value to indicate that column Const testCol = "A" Dim summaryWS As Worksheet Dim anyWS As Worksheet Dim lastRow As Long Dim testList As Range Dim anyTestCell As Range Dim row2Copy As Range Dim rowPointer As Long 'change this to the summary sheet's name Set summaryWS = ThisWorkbook.Worksheets("Sheet1") 'to improve performance Application.ScreenUpdating = False 'begin the actual work For Each anyWS In ThisWorkbook.Worksheets If anyWS.Name summaryWS.Name Then lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row If lastRow 1 Then Set testList = anyWS.Range(testCol & "2:" & _ testCol & lastRow) For Each anyTestCell In testList If Not IsEmpty(anyTestCell) Then Set row2Copy = anyWS.Rows(anyTestCell.Row & _ ":" & anyTestCell.Row) row2Copy.Copy summaryWS.Range(testCol & Rows.Count).End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues 'if you also want formats copied, then 'remove the ' in front of this next line of code 'summaryWS.Range(testCol & Rows.Count).End(xlUp). _ PasteSpecial xlPasteFormats End If ' end IsEmpty test block Next ' end anyTestCell loop End If 'end test for lastRow End If ' end test for sheet name matchup Next ' end anyWS loop 'do some housekeeping Set testList = Nothing Set row2Copy = Nothing Set summaryWS = Nothing MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done" End Sub "wild turkey no9" wrote: I have data all structured in the same way (same column headings) across multiple sheets within the same workbook. Is there an easy way to concatenate all of the data, without any empty rows, into one summary sheet in the workbook? Thanks in advance. Kevin |
#7
|
|||
|
|||
Help With Macro
|
Thread Tools | |
Display Modes | |
|
|