Merging 1 common sheet from multiple files

Nanogirl21

Active Member
Joined
Nov 19, 2013
Messages
330
Office Version
  1. 365
Platform
  1. Windows
I have 52 workbooks in 1 desktop folder with multiple worksheets. In each workbook, there is a common sheet named Raw Data. How can I merge all the Raw Data worksheets into 1 master workbook? The columns are different in all 52 workbooks, so it would be helpful to have the original file name in column ZZ of each new worksheet in the master workbook. Any help with this is appreciated.
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Copy all the code into a module. Fit the names in the user data section.

Run the macro "MergingMultipleFiles_IntoMasterworkbook"
VBA Code:
Sub MergingMultipleFiles_IntoMasterworkbook()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sPath As String, sFile As String, sName As String
  Dim lr1 As Long, lr2 As Long
  
  'user data section
  Set sh1 = ThisWorkbook.Sheets("Master")   'Master workbook sheet name
  sPath = "C:\trabajo\files\"               'desktop folder name
  sName = "Raw Data"                        'common sheet name
  
  sh1.Cells.Clear
  sh1.Range("ZZ1").Value = "original file name"
  sFile = Dir(sPath & "*.xls*")
  Do While sFile <> ""
    If HasSheet(sPath, sFile, sName) Then
      Set sh2 = Workbooks.Open(sPath & sFile).Sheets(sName)
      lr1 = sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
      lr2 = sh2.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
      sh2.Rows("1:" & lr2).Copy sh1.Range("A" & lr1)
      sh1.Range("ZZ" & lr1).Resize(lr2).Value = sFile
      sh2.Parent.Close False
    End If
    sFile = Dir()
  Loop
End Sub

Function HasSheet(fPath As String, fName As String, sheetName As String)
  Dim f As String
  f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"
  HasSheet = Not IsError(Application.ExecuteExcel4Macro(f))
End Function
 
Upvote 0
Hi,

Try this update to a code I did recently for another here with similar requirement & see if helps you.

Code should copy specified sheet from each file in folder, insert into your workbook & rename name the Tab with FileName.

Rich (BB code):
Sub MergeMe()
    
    Dim FileName       As String
    Dim wb             As Workbook
    
    '************************************************************************
    '                 SETTINGS CHANGE AS REQUIRED
    '************************************************************************
    Const CopySheet    As String = "Raw Data"
    
    Const FilePath     As String = "C:\MyDesktop\"
    
    Const FileFormat   As String = "*.xlsx"
    '************************************************************************
    
    
    FileName = Dir(FilePath & FileFormat, vbDirectory)
    
    On Error GoTo myerror
    Application.ScreenUpdating = False
    
    Do While FileName <> ""
        
        Set wb = Workbooks.Open(FilePath & FileName, False, True)
        wb.Sheets(CopySheet).Copy After:=ThisWorkbook.Sheets(1)
        ActiveSheet.Name = Left(Mid(FileName, 1, Len(FileName) - 5), 31)
        wb.Close False
        
nextfile:
        FileName = Dir()
        Set wb = Nothing
    Loop
    
    
myerror:
    If Not wb Is Nothing Then wb.Close False
    'copysheet missing
    If Err.Number = 9 Then Resume nextfile
    
    Application.ScreenUpdating = True
    If Err <> 0 Then
    'all other errors
        MsgBox (Error(Err)), 48, "Error"
    Else
    'inform user
        MsgBox "Merge Complete", 64, "Merge"
    End If
    
End Sub

Change values in settings as required

Dave
 
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top