Merge sheet with same name from multiple workbooks.

[Gman]

Hello -

Does anyone know a VBA code that will go into the folder I specify and find the one sheet name I specify and merge into one document?


For example I have one folder with 20 excel files. I want it to go into each file find the sheet called "Variance Report" and merge all those sheets into one excel file. But each with own sheet. In the end having one excel file with 20 different "Variance Report" sheets.


Thank you in advance for any help.


Greg

 

[Chihiro]

Something like below. Put the code in the workbook where you want to add sheets.

Sub Test()
Dim fd As FileDialog
Dim FilePicked As Integer, f As Integer
Dim sWb As Workbook
Dim ws As Worksheet

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "C:\Test" 'Adjust initial folder as needed
fd.AllowMultiSelect = True
FilePicked = fd.Show

Application.ScreenUpdating = False

If FilePicked = 0 Then
    Application.ScreenUpdating = True
    Exit Sub
Else
    For f = 1 To fd.SelectedItems.Count
        Set sWb = Workbooks.Open(fd.SelectedItems(f))
        For Each ws In sWb.Worksheets
            If ws.Name = "Variance Report" Then
                ws.Copy _
                After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            End If
        Next ws
        sWb.Close False
    Next f
End If

Application.ScreenUpdating = True

End Sub

 

[Gman]

Something like below. Put the code in the workbook where you want to add sheets.

Sub Test()
Dim fd As FileDialog
Dim FilePicked As Integer, f As Integer
Dim sWb As Workbook
Dim ws As Worksheet

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "C:\Test" 'Adjust initial folder as needed
fd.AllowMultiSelect = True
FilePicked = fd.Show

Application.ScreenUpdating = False

If FilePicked = 0 Then
    Application.ScreenUpdating = True
    Exit Sub
Else
    For f = 1 To fd.SelectedItems.Count
        Set sWb = Workbooks.Open(fd.SelectedItems(f))
        For Each ws In sWb.Worksheets
            If ws.Name = "Variance Report" Then
                ws.Copy _
                After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            End If
        Next ws
        sWb.Close False
    Next f
End If

Application.ScreenUpdating = True

End Sub

Something like below. Put the code in the workbook where you want to add sheets.

Sub Test()
Dim fd As FileDialog
Dim FilePicked As Integer, f As Integer
Dim sWb As Workbook
Dim ws As Worksheet

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "C:\Test" 'Adjust initial folder as needed
fd.AllowMultiSelect = True
FilePicked = fd.Show

Application.ScreenUpdating = False

If FilePicked = 0 Then
    Application.ScreenUpdating = True
    Exit Sub
Else
    For f = 1 To fd.SelectedItems.Count
        Set sWb = Workbooks.Open(fd.SelectedItems(f))
        For Each ws In sWb.Worksheets
            If ws.Name = "Variance Report" Then
                ws.Copy _
                After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            End If
        Next ws
        sWb.Close False
    Next f
End If

Application.ScreenUpdating = True

End Sub

Thank you for the reply. I am relatively new to VBA. I copied your code into a module after pushing F11. Then where you said "Adjust folder as needed" I put in the folder where all the excel files are saved. When I run the file a browse folder opens showing all the documents I want the sheets out of but doesn't do anything else? Thanks again for any help.

 

[Chihiro]

Select files in the folder like you would in explorer and hit "Open" button. Code will take care of the rest.

 

[Gman]

Worked perfectly. Thank you so much, you don't know how much time you just saved me every month!

Thank you again!