Copying ranges from one sheet into another using a loop of sheet names

Question

I am attempting to compile tables from 118 sheets into two tables (59 tables each). I have a list of all sheet names within the sheet "Sheet Listing." Currently my code only returns the table from the last sheet, presumably overwriting all the others. For the first set of 59 sheets, the range on every sheet is the same ("A5:F73"). For the next 59 sheets, the number of rows varies between 69 and 68 rows, so I guess the easiest way to deal with that is to write code that would begin a selection at cell A5 (always), select all columns over to column F, then do a row count to determine the last row to copy.

Below is what I have cobbled together so far for the set of sheets with a known range:

Sub ConsolData()

Dim sheet_name As Range
Dim lastrowdata As Long

With Sheets("SB Summary")
    lastrowdata = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With

For Each sheet_name In Sheets("Sheet Listing").Range("D6:D64") 
If sheet_name.value = "" Then 
    exit For 

Else
    Sheets(sheet_name.value).select 
    Range("A5:F73").Select 
Selection.Copy

Sheets("SB Summary").select
Range("B2").Offset(lastrowdata).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False
Sheets(sheet_name.value).select
End If
Next sheet_name

End Sub

I think the problem lies with the line of code specifying the last row of data to paste into:

Range("B2").Offset(lastrowdata).Select

Question 1: How do I correctly specify the offset in order to prevent overwriting previously pasted tables?

Question 2: Would it be easier to modify this code to also handle the dynamic ranges of the second set of 59 tables so that it works for this first set of 59 static/known ranges?

Question 3: For each range copied, I'd like to fill in the sheet name into all the cells in column H next to what was just pasted so that I know where it came from. How do I do that?

L42 L42 · Accepted Answer · 2014-07-16T23:54:02

You are correct in your analysis that your code overwrites the previous data copied with the latest one.
So in the end you'll only have the last data.
I've re-written your code a bit to solve that also covering the dynamic data source.

Sub ConsolData()
    Dim sheet_name As Range
    Dim lastrowdata As Long
    '~~> Added this so it looks clean
    Dim ws As Worksheet: Set ws = Sheets("SB Summary")

    With Application
        .ScreenUpdating = False
    End With

    For Each sheet_name In Sheets("Sheet Listing").Range("D6:D64")
        If sheet_name.Value = "" Then
            Exit For
        Else
            '~~> Work on your sheet object directly
            With Sheets(sheet_name.Value)
                '~~> Find the last row of data from target sheet
                '~~> I used this method since you mention Table
                lastrowdata = .Range("A:A").Find("*", [A1], , , , xlPrevious).Row
                .Range("A5:F" & lastrowdata).Copy
                '~~> Find the lastrow in destination sheet
                ws.Range("B:B").Find("*", [B1], , , , xlPrevious) _
                    .Offset(1, 0).PasteSpecial xlPasteValues
            End With
        End If
    Next sheet_name

    With Application
        .ScreenUpdating = False
        .CutCopyMode = False
    End With
End Sub

Above code uses Range Object Find Method to find the last rows everytime you work on your sheet object.
In the SB Summary we use Offset Method to paste the values below the last row with data.
HTH.

BTW, you might be interested in reading below link to further improve your coding.

How to avoid using Select in Excel VBA macros

Copying ranges from one sheet into another using a loop of sheet names

1 Answers