Combine sheets from different workbooks with same name

Question

I'm trying to solve an issue i'm currently dealing with. Below you'll find the issue:

I'm having multiple excel sheets that I'd like to merge into one file (located into different workbooks). Each workbook consists out of the same sheets (SHEET1, SHEET2, SHEET3).

I'd like to merge all workbooks into 1 masterfile - and want to keep the same structure (SHEET1 = all date form all sheets).

So far I've manged to solve the merging issue with the below code:

Sub mergeFiles()
Dim numberOfFilesChosen, i As Integer
Dim tempFileDialog As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet

Set mainWorkbook = Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

tempFileDialog.AllowMultiSelect = True

numberOfFilesChosen = tempFileDialog.Show

For i = 1 To tempFileDialog.SelectedItems.Count
    
    Workbooks.Open tempFileDialog.SelectedItems(i)
    
    Set sourceWorkbook = ActiveWorkbook
    
    For Each tempWorkSheet In sourceWorkbook.Worksheets
        tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
    Next tempWorkSheet
    
    sourceWorkbook.Close
Next i
End Sub

I navigate via de Application.FileDialog to the folder with the different sheets. I select the files i want to merge, and then VBA does its job, and merges the files into one Excel sheet.

Hence some of the sheets are having the same name (=always) = SHEET 1, SHEET 2, SHEET 3, the merged sheets are having the same name with a figure behind (= SHEET1 (1), SHEET1 (2) ...)

I've managed to merge all the sheets into one worksheet, using the below code - but i can't mange to add a restriction to it - e.g. merge all the sheets starting with (SHEET1* into MASTERDATA SHEET1, SHEET2 * into MASTERDATA SHEET2, SHEET3 * into MASTERDATA SHEET3)

Sub Merge_Sheets()
Sheets.Add
ActiveSheet.Name = "MASTERDATA"

For Each ws In Worksheets
    ws.Activate
    
    If ws.Name <> "MASTERDATA" Then
        ws.UsedRange.Select
        Selection.Copy
        Sheets("MASTERDATA").Activate
        
        ActiveSheet.Range("A1048576").Select
        Selection.End(xlUp).Select
        
        If ActiveCell.Address <> "$A$1" Then
            ActiveCell.Offset(1, 0).Select
        End If
        
        ActiveSheet.Paste
    
    End If
    
Next
End Sub

Could any of you help me out + explain briefly the next step?

Kind Regards D

Super Symmetry Super Symmetry · Accepted Answer · 2020-08-18T09:15:04

You should check if the sheet name already exists in mainWorkbook. If it does append that data to the end of that sheet rather than insert a new worksheet. Therefore, you do not need to the second code

Try this (not tested and you might need to debug it, also note comments starting with '*)

Sub mergeFiles()
    '* declare the type for each variable (no just at the end of the line)
    '* always use Long if you're tempted to use Integer
    Dim numberOfFilesChosen As Long, i As Long
    Dim tempFileDialog As FileDialog
    Dim mainWorkbook As Workbook, sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    
    '* declare the destination sheet
    Dim destWorkSheet As Worksheet
    
    Set mainWorkbook = ThisWorkbook ' Application.ActiveWorkbook
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    tempFileDialog.AllowMultiSelect = True
    
    numberOfFilesChosen = tempFileDialog.Show
    
    For i = 1 To tempFileDialog.SelectedItems.Count
        
        '* you can set sourceWorkbook directly here
        Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))
        
        'Set sourceWorkbook = ActiveWorkbook
        
        On Error Resume Next
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            Set destWorkSheet = mainWorkbook.Sheets(tempWorkSheet.Name)
            
            If Err.Number > 0 Then '* worksheet doesn't exist in mainWorkbook
                tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
                Err.Clear
            Else '* worksheet already exists
                With tempWorkSheet.UsedRange
                    .Copy Destination:=destWorkSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                    '* If you only want to copy the values remove the above line and uncomment the below line
                    'destWorkSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
                End With
            End If
        Next tempWorkSheet
        On Error GoTo 0

        sourceWorkbook.Close
    Next i
End Sub

Combine sheets from different workbooks with same name

1 Answers