Merge Worksheets with same file name from Different Excel files

[hsayus]

HI,

I have multiple Excel files with same worksheet names. I want a macros to merge the worksheets with same file name into new Excel File.

Example:
File Name A >>> Worksheet names >>> Annex1.1, Annex1.2, Annex1.3, Annex1.4 and so on
File Name B >>> Worksheet names >>> Annex1.1, Annex1.2, Annex1.3, Annex1.4 and so on
File Name C >>> Worksheet names >>> Annex1.1, Annex1.2, Annex1.3, Annex1.4 and so on

Output:

New File. Data of worksheet name Annex1.1 from all 3 excel files to be merged and stored in Worksheet Name Annex1.1, Data of worksheet name Annex1.2 from all 3 excel files to be merged and stored in Worksheet Name Annex1.2, Data of worksheet name Annex1.3 from all 3 excel files to be merged and stored in Worksheet Name Annex1.3 and so on..........
But the Heading should not be repeated from all the files. I have my heading from A4 so it should not be repeated while combining the file.

Please help me with the VBA script code.

 

[DanteAmor]

Try this


Put the macro in a book.
Put the books that contain the sheets to be joined in a folder.
Put the name of the folder in the code.
Execute the code. The sheets will be joined in the book that contains the macro.

Sub Merge_Worksheets()
  Dim wFolder As String, wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim wFiles As Variant, exists As Boolean, lr1 As Long, lr2 As Long, ini As Long
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  wFolder = "[B][COLOR=#ff0000]C:\trabajo\books\[/COLOR][/B]"
  Set wb1 = ThisWorkbook
  wFiles = Dir(wFolder & "*.xls*")
  Do While wFiles <> ""
    Set wb2 = Workbooks.Open(wFolder & wFiles)
    For Each sh2 In wb2.Sheets
      exists = False
      For Each sh1 In wb1.Sheets
        If LCase(sh1.Name) = LCase(sh2.Name) Then
          exists = True
          ini = 5
          lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row + 1
          Exit For
        End If
      Next
      If exists = False Then
        wb1.Sheets.Add after:=wb1.Sheets(wb1.Sheets.Count)
        Set sh1 = wb1.Sheets(wb1.Sheets.Count)
        sh1.Name = sh2.Name
        ini = 4
        lr1 = 4
      End If
      lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
      sh2.Rows(ini & ":" & lr2).Copy
      sh1.Range("A" & lr1).PasteSpecial xlPasteValues
    Next
    wb2.Close False
    wFiles = Dir()
  Loop
  MsgBox "End"
End Sub