I am attempting a macro that collects data (from row 2 to the base of the data set, columns A-P) from sheets (D10-D#) and consolidates the data into a "MasterData" Sheet in the current workbook.

What I'd like the macro to perform:

Go to sheet "D10" > Copy data from row 2, columns A-P, to the base of the data set > Paste the dataset into "MasterData" sheet > Copy & paste the next tab "D11"'s data in the row immediately after the "D10" dataset in the "MasterData" sheet > Repeat until I have completed all "D#"

My code:

Sub Combine()

'Select Department data
Sheets("D10").Select 'Start in sheet D10
Range("A2").Select 'Start at cell A2
Range(Selection, Selection.End(xlDown)).Select 'Go to the end of the data set
Range(Selection, Selection.End(xlToRight)).Select 'Go to the right of the data set
Selection.Copy 'Copy the data set

'Now Paste the data into MasterData
Sheets("MasterData").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste

'Select Another Departments data
Sheets("D11").Select ' Move to sheet D11
Range("A2").Select 'Start at cell A2
Range(Selection, Selection.End(xlDown)).Select 'Go to the end of the data set
Range(Selection, Selection.End(xlToRight)).Select 'Go to the right of the data set
Application.CutCopyMode = False
Selection.Copy 'Copy the data set

'Now Paste the data into MasterData
Sheets("MasterData").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Range("A1").Select

End Sub

Thank you for any help you can provide.

CodePudding user response：

(not tested) assuming your code works following should work:

for each sheet in Sheets
    with sheet
    if .name like "D#" or .name like "D##" or .name like "D###" then
        'Select Department data
        .activate
        Range("A2").Select 'Start at cell A2
        Range(Selection, Selection.End(xlDown)).Select 'Go to the end of the data set
        Range(Selection, Selection.End(xlToRight)).Select 'Go to the right of the data set
        Selection.Copy 'Copy the data set

        'Now Paste the data into MasterData
        Sheets("MasterData").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveSheet.Paste
    end if
    end with
Next

CodePudding user response：

Append Worksheet Data

• Copies table data from all worksheets, whose name starts with a D followed by two digits, to the MasterData worksheet.
• If CopyHeaders is set to True, the headers from the first found worksheet will also be copied.

Option Explicit

Sub AppendWorksheetData()

    ' Source
    Const sNamePattern As String = "D##"
    Const sfcAddress As String = "A1"
    ' Destination
    Const dName As String = "MasterData"
    Const dfcAddress As String = "A1"
    ' Both
    Const CopyHeaders As Boolean = True
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Reference initial active sheet.
    Dim iash As Object: Set iash = ActiveSheet
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim diCell As Range: Set diCell = dws.Range(dfcAddress)
    Dim dCell As Range: Set dCell = diCell
    
    Application.ScreenUpdating = False
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim wsCount As Long
    
    For Each sws In wb.Worksheets
        If UCase(sws.Name) Like UCase(sNamePattern) Then
            wsCount = wsCount   1
            If wsCount = 1 And CopyHeaders Then
                Set srg = sws.Range(sfcAddress).CurrentRegion
            Else
                With sws.Range(sfcAddress).CurrentRegion
                    Set srg = .Resize(.Rows.Count - 1).Offset(1)
                End With
            End If
            srg.Copy dCell
            Set dCell = dCell.Offset(srg.Rows.Count)
        End If
    Next sws

    ' Clear below.
    With dCell
        .Resize(dws.Rows.Count - .Row   1, srg.Columns.Count).Clear
    End With
    
    ' Copy column widths.
    srg.Rows(1).Copy
    With diCell
        .PasteSpecial xlPasteColumnWidths
        Application.CutCopyMode = False
        dws.Select
        ActiveWindow.ScrollRow = .Row
        ActiveWindow.ScrollColumn = .Column
        .Select
    End With
    
    ' Reference initial active sheet.
    iash.Select
    
    Application.ScreenUpdating = True
    
    MsgBox "Data from " & wsCount & " worksheets appended.", vbInformation
  
End Sub