VBA to move rows to totaling sheet only pulls one tab from workbook

[pile-it Mark]

i found this code on thru a yahoo search and modified it to fit my workbook.

my workbook will eventually have up to 360 tabs. it currently has 6. the code only pulls row 1(that is the only row it is supposed to grab) from the last tab (supposed to grab every tab). it does not matter which tab i move to the end, the last one is the only data that is transferred.

obviously i have missed something.

I appreciate any ideas.

Mark

 ' https://msdn.microsoft.com/en-us/library/cc793964(v=office.12).aspx   Ron de Bruin
 

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            
            ' Specify the range to place the data.
            Set CopyRng = sh.Range("A1:AZ1")

            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                GoTo ExitTheSub
            End If

            ' This statement copies values and formats from each
            ' worksheet.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            ' Optional: This statement will copy the sheet
            ' name in the AAcolumn.
            DestSh.Cells(Last + 1, "AA").Resize(CopyRng.Rows.Count).Value = sh.Name

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

[code]

 

[MARK858]

You aren't setting a value for Last anywhere and so it is just overwriting the same Row each time.

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then


            ' Specify the range to place the data.
            Set CopyRng = sh.Range("A1:AZ1")
           [COLOR="#FF0000"]Last = DestSh.Range("A" & Rows.Count).End(xlUp).Row[/COLOR]
            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                       "summary worksheet to place the data."
                GoTo ExitTheSub
            End If

            ' This statement copies values and formats from each
            ' worksheet.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            ' Optional: This statement will copy the sheet
            ' name in the AAcolumn.
            DestSh.Cells(Last + 1, "AA").Resize(CopyRng.Rows.Count).Value = sh.Name

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[pile-it Mark]

Thank YOU! it works great! i will continue testing.

i went back at looked at the page thinking i must have deleted that line when i changed the range, but it was not there.

i would never have found that.

Mark