Merge sheet with same name from multiple workbooks.

[gman23]

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

 

[Fishboy]

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

Hi Greg, welcome to the boards.

This is untested but I believe this should do what you describe. Put the following code in a standard module in your main workbook (the one being copied to). It should pop up with a folder picker allowing you to specify what folder to look in. You may need to change the bold red "*.xlsx" part of my code to suit whatever file extension the workbooks are saved as. Remember to prefix the file extension with the * and the . or it wont work.

Sub LoopThroughFilesInFolder()
Dim wb As Workbook
Dim wb2 As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim x As Long
Dim FldrPicker As FileDialog


'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False


' Sets wb As the master workbook
Set wb = ThisWorkbook
' Defines variable x as 1
x = 1


'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


With FldrPicker
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With


'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
myExtension = "*.xlsx"


'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)


'Loop through each Excel file in folder
Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb2 = Workbooks.Open(Filename:=myPath & myFile)
    ' Copy Variance Report sheet to the end of the main workbook
    wb2.Sheets("Variance Report").Copy After:=wb.Sheets(Workbooks(wb).Sheets.Count)
    ' Renames the copied sheet to Variance Report and the current value of x
    wb.Sheets("Variance Report").Name = "Variance Report " & x
    ' Increases x by 1 to account for the new sheet
    x = x + 1
    'Close Workbook 2
    wb2.Close SaveChanges:=False
    'Get next file name
    myFile = Dir
Loop


'Message Box when tasks are completed
MsgBox "Task Complete!"


ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub