Combine worksheets from multiple workbooks

[chlearning]

Good day experts, I'm attempting to combine one sheet out of multiple workbooks into the sheet where my module is located. The workbooks are located in the same file on the network, but I don't want all of them. The sheet name is the same in each workbook. I found a code that works well at pulling all sheets from the selected workbooks, but I only want the sheets named "BOM".

Also, this code drops the sheets into their own sheet in my "BOM Builder" workbook. I would like to combine these starting at B6 on sheet "BOM". I want the first heading (merged cells A1:F1, always the same location) in B6 and the cells (A5:E?) to start in the next row down. The number of rows varies. The next workbook "BOM" sheet copied would then skip a row, insert the heading and cells from that sheet, and so on.

If someone could tell me where/how to make it pull only the sheets I want, and then a separate sub to merge them the way I'm looking for, I would really appreciate it.

Here is the code that pulls the worksheets from the selected workbooks now.


Sub MergeExcelFiles()
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook

fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

If (vbBoolean <> VarType(fnameList)) Then

If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wbkCurBook = ActiveWorkbook

For Each fnameCurFile In fnameList
countFiles = countFiles + 1

Set wbkSrcBook = Workbooks.Open(fileName:=fnameCurFile)

For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next

wbkSrcBook.Close SaveChanges:=False

Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End If

Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub

 

[DanteAmor]

Welcome to the Board!

Try this:

Sub MergeExcelFiles_V2()
  Dim fnameList As Variant, fnameCurFile As Variant
  Dim countFiles As Long, countSheets As Integer, lr As Long, lr2 As Long
  Dim wksCurSheet As Worksheet, sh1 As Worksheet, SheetName As String
  Dim wbkCurBook As Workbook, wbkSrcBook As Workbook
 
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
  If vbBoolean = VarType(fnameList) Then
    MsgBox "No files selected", Title:="Merge Excel files"
    Exit Sub
  End If
  If UBound(fnameList) = 0 Then
    Exit Sub
  End If
 
  countFiles = 0
  countSheets = 0
  Set wbkCurBook = ActiveWorkbook
  Set sh1 = wbkCurBook.Sheets("BOM Builder")
  sh1.Cells.Clear
  SheetName = "BOM"
 
  For Each fnameCurFile In fnameList
    countFiles = countFiles + 1
    Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
    On Error Resume Next
    If Evaluate("=ISREF('[" & wbkSrcBook.Name & "]" & SheetName & "'!A1)") Then
      If Err.Number = 0 Then
        On Error GoTo 0
        With wbkSrcBook.Sheets(SheetName)
          countSheets = countSheets + 1
          lr = sh1.Range("B" & Rows.Count).End(xlUp).Row + 2
          If lr < 6 Then lr = 6
          .Range("A1:F1").Copy sh1.Range("B" & lr)
          lr = lr + 1
          lr2 = .Range("B" & Rows.Count).End(xlUp).Row
          .Range("A5:E" & lr2).Copy sh1.Range("B" & lr)
        End With
      End If
    End If
    On Error GoTo 0
    wbkSrcBook.Close SaveChanges:=False
  Next
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End Sub

 

[chlearning]

Welcome to the Board!

Thank you for the help! Unfortunately I get an error at the Set sh1 = wbkCurBook.Sheets("BOM Builder") line. The error is a Run-time error '9': Subscript out of range

My current workbook (BOM Builder) is in a different location than the workbooks (various names) I'm copying from, if that makes a difference.

 

[DanteAmor]

You have to put the macro in the book where you have this sheet "BOM Builder"
OR
You have to open the book where you have the "BOM Builder" sheet and on that sheet run the macro.

 

[chlearning]

The macro is in the BOM Builder workbook. I also have it open. I'm still getting the error.

 

[Fluff]

Is your sheet called "BOM" or "BOM Builder", or even something else?

 

[chlearning]

Is your sheet called "BOM" or "BOM Builder", or even something else?

The sheet in each workbook that I want to copy is named "BOM".
The workbook I want to copy in to is named "BOM Builder".
The sheet in the workbook that I want to copy to is called "BOM".

I can change the names of where it needs copied to if it causes issues, but the sheets that I'm copying from are in various network locations, in folders named various things, and workbooks with different names, but all have a sheet named BOM.

 

[Fluff]

In that case change this

 Set sh1 = wbkCurBook.Sheets("BOM Builder")

to

 Set sh1 = wbkCurBook.Sheets("BOM")

 

[DanteAmor]

Chage

Set sh1 = wbkCurBook.Sheets("BOM Builder")

By:

Set sh1 = wbkCurBook.Sheets("BOM")

 

[chlearning]

That worked great! Thank you.