'Append data from multiple worksheet to single worksheet macro
Sub CombineData()

    Dim wksFirst As Worksheet
    Dim wksLast As Worksheet
    Dim wksDest As Worksheet
    Dim strFirstSht As String
    Dim strLastSht As String
    Dim strDestSht As String
    Dim NextRow As Long
    Dim i As Long
    
    strFirstSht = "Sheet1" 'change the name of the first sheet accordingly
    strLastSht = "Sheet2" 'change the name of the last sheet accordingly
    strDestSht = "Combined Data" 'change the name of the destination sheet accordingly
    
    On Error Resume Next
    Set wksFirst = Worksheets(strFirstSht)
    If wksFirst Is Nothing Then
        MsgBox strFirstSht & " does not exist...", vbInformation
        Exit Sub
    Else
        Set wksLast = Worksheets(strLastSht)
        If wksLast Is Nothing Then
            MsgBox strLastSht & " does not exist...", vbInformation
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(strDestSht).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set wksDest = Worksheets.add(Worksheets(1))
    
    wksDest.Name = strDestSht
    
    For i = wksFirst.Index To wksLast.Index
        Worksheets(i).Range("A1:H89").Copy
        With wksDest
            NextRow = .Cells(.Rows.count, "A").End(xlUp).row + 1
            With .Cells(NextRow, "A")
                .PasteSpecial Paste:=8 'column width for Excel 2000 and later
                .PasteSpecial Paste:=xlPasteValues
                .PasteSpecial Paste:=xlPasteFormats
            End With
        End With
    Next i
    
    wksDest.Cells(1).Select
    
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
    
End Sub

'Append data from multiple worksheet to single worksheet macro

'Append data from multiple worksheet to single worksheet macro

excel

Visual Basic