VBA macro for appending data from an excel file to a Master excel file sheetwise.

[Akshay1]

Expected results -
data in worksheet Sheet1 of excel file should be appended to worksheet Sheet1 of 'Master' excel file
data in worksheet XYZ of excel file should be appended to worksheet XYZ of 'Master' excel file. If a worksheet named XYZ does not exist in 'Master' excel file, then creates one.

 

[John_w]

How will you specify the 'other' workbook (Excel file)? This code goes in the 'Master' workbook (.xlsm file) and the full path and file name of the other workbook is specified in the otherWorkbookFile string, though this could be changed to allow the user to browse for it. The macro opens this file if it isn't already open.

Public Sub Append_Sheets_From_Other_Workbook()

    Dim otherWorkbookFile As String
    Dim otherWb As Workbook
    Dim otherWs As Worksheet
    Dim destWs As Worksheet
    Dim destCell As Range
    
    otherWorkbookFile = "C:\path\to\Other Workbook.xlsx"   'CHANGE THIS
    
    Application.ScreenUpdating = False
    
    Set otherWb = Nothing
    On Error Resume Next
    Set otherWb = Workbooks.Open(otherWorkbookFile, ReadOnly:=True)
    On Error GoTo 0
    
    If Not otherWb Is Nothing Then
        For Each otherWs In otherWb.Worksheets
            Set destWs = Nothing
            On Error Resume Next
            Set destWs = ThisWorkbook.Worksheets(otherWs.Name)
            On Error GoTo 0
            If destWs Is Nothing Then
                Set destWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
                destWs.Name = otherWs.Name
                Set destCell = destWs.Range("A1")
            Else
                Set destCell = destWs.Cells(destWs.Rows.Count, 1).End(xlUp)
                If destCell.Row > 1 Then Set destCell = destCell.Offset(1)
            End If
            otherWs.Range("A1").CurrentRegion.Copy destCell
        Next
        otherWb.Close False
    Else
        MsgBox "Not found other workbook " & otherWorkbookFile, vbExclamation
    End If
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub