Append data from multiple worksheet to single worksheet macro

[AlbertV]

I have a workbook with a large number of worksheets. The data in most worksheets has the same structure. For these worksheets I would like to have a macro that appends the data to a single sheet. Since the data on the worksheet have reference included I would like the data to be paste values or paste link. The data I need from the worksheets is in A6:H89.

Since I also have worksheets with other data included in the workbook I would like to be able to limited the worksheets that will be appended. I don't know if this can be done to have these worksheets start and end with a certain name (start/end).

Help would be appreciated

 

[Domenic]

Try...

Option Explicit

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 = "Sheet2" 'change the name of the first sheet accordingly
    strLastSht = "Sheet3" '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("A6: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

 

[AlbertV]

Thank you, work perfectly

 

[Domenic]

You're very welcome!