Combine specific sheets from multiple workbooks into 1 workbook.

Combine specific sheets from multiple workbooks into 1 workbook.

I have several similar workbooks. I want to copy specific worksheets (but not all) from each workbook and paste into 1 workbook. tab names can be the same with just a # on the end.

I saw that you also posted in another thread in this forum. That is frowned upon and called "Hijacking".

Re: specific worksheets (but not all)

Which ones?

Is that all the workbooks in a specific folder?
If not, how to know which ones?
Just add a number to the sheet name?

In the absence of more information, try this.
Workbook with code in it (Master) cannot be saved in same folder where workbooks are where you copy from.
Only first sheet of all workbooks are copied and saved in Master

Code:

---

Sub CombineFiles()
Application.ScreenUpdating = False
Dim path As String
Dim fileName As String
Dim wkb As Workbook
Dim j As Long
j = 1
path = "C:\Folder name\Subfolder Name"    '<---- Change as required
fileName = Dir(path & "\*.xl*", vbNormal)    '<---- All type excel files. Change if required


Do Until fileName = ""
    Set wkb = Workbooks.Open(fileName:=path & "\" & fileName)
        wkb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ThisWorkbook.Sheets(Sheets.Count).Name = "Import # " & j
        j = j + 1
    wkb.Close False
    fileName = Dir()
Loop


Application.ScreenUpdating = True
End Sub

---

Another version

Code:

---

Sub ConsolidateSheets()    Dim FileName    As String
    Dim wkb        As Workbook
    Dim Wks        As Worksheet
    Dim secAutomation As MsoAutomationSecurity

    Dim BookMaster  As Workbook
    Dim ThisPath    As String
    Dim ThisName    As String

    Dim varrSheets  As Variant
    Dim i          As Long


    varrSheets = Split("My Sheet 1*My Sheet3*MySheet7", "*")

    Set BookMaster = ThisWorkbook
    ThisPath = BookMaster.Path & Application.PathSeparator
    ThisName = BookMaster.Name

    'Same folder as the main file
    FileName = Dir(BookMaster.Path & Application.PathSeparator & "*.xls*")
    'Or...
    'Other selected folder
    'FileName = Dir("e:\My Folder\My Subfolder\*.xls*")

    secAutomation = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    Application.ScreenUpdating = False


    Do Until Len(FileName) = 0
       
        If FileName <> ThisName Then '<~~ remove this condition if you selected 'Other selected folder'
           
            Set wkb = Workbooks.Open(FileName)

            For i = 0 To UBound(varrSheets)
                If IsSheetExists(wkb, varrSheets(i)) Then
                    Set Wks = wkb.Worksheets(varrSheets(i))


                    With BookMaster
                        Wks.Copy After:=.Sheets(.Sheets.Count)
                    End With
                End If
            Next i

            wkb.Close False
           
        End If 'FileName <> ThisName

        FileName = Dir()

    Loop


    Application.AutomationSecurity = secAutomation
   
    MsgBox "Done", vbInformation
End Sub


Function IsSheetExists(wkb As Workbook, SheetName As String) As Boolean
  Dim sh As Object
 
  On Error Resume Next
  Set sh = wkb.Sheets(SheetName)
  On Error GoTo 0
 
  IsSheetExists = Not (sh Is Nothing)
End Function

---

Artik

Quote:

---

Originally Posted by Artik

Another version

Code:

---

Sub ConsolidateSheets()   
Dim FileName    As String
    Dim wkb        As Workbook
    Dim Wks        As Worksheet
    Dim secAutomation As MsoAutomationSecurity

    Dim BookMaster  As Workbook
    Dim ThisPath    As String
    Dim ThisName    As String

    Dim varrSheets  As Variant
    Dim i          As Long


    varrSheets = Split("My Sheet 1*My Sheet3*MySheet7", "*")

    Set BookMaster = ThisWorkbook
    ThisPath = BookMaster.Path & Application.PathSeparator
    ThisName = BookMaster.Name

    'Same folder as the main file
    FileName = Dir(BookMaster.Path & Application.PathSeparator & "*.xls*")
    'Or...
    'Other selected folder
    'FileName = Dir("e:\My Folder\My Subfolder\*.xls*")

    secAutomation = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    Application.ScreenUpdating = False


    Do Until Len(FileName) = 0
       
        If FileName <> ThisName Then '<~~ remove this condition if you selected 'Other selected folder'
           
            Set wkb = Workbooks.Open(FileName)

            For i = 0 To UBound(varrSheets)
                If IsSheetExists(wkb, varrSheets(i)) Then
                    Set Wks = wkb.Worksheets(varrSheets(i))


                    With BookMaster
                        Wks.Copy After:=.Sheets(.Sheets.Count)
                    End With
                End If
            Next i

            wkb.Close False
           
        End If 'FileName <> ThisName

        FileName = Dir()

    Loop


    Application.AutomationSecurity = secAutomation
   
    MsgBox "Done", vbInformation
End Sub


Function IsSheetExists(wkb As Workbook, SheetName As String) As Boolean
  Dim sh As Object
 
  On Error Resume Next
  Set sh = wkb.Sheets(SheetName)
  On Error GoTo 0
 
  IsSheetExists = Not (sh Is Nothing)
End Function

---

Artik

---

And how did you write this line

Code:

---

    varrSheets = Split("My Sheet 1*My Sheet3*MySheet7", "*")

---

And for the future. Do not quote the entire statement of his predecessor, because it makes no sense.

Artik

varrSheets = Split("Plan*Material*Risk Plan"P&ID's", "*")

If your sheet name contains quotation marks, you must duplicate each character to create a string for the Split function:

Code:

---

varrSheets = Split("Plan*Material*Risk Plan""P&ID's""", "*")

---

if the last sheet name is Risk Plan"P&ID's".

Artik

i can't seem to post anything else on this thread. but, i'm getting a "ByRef mismatch" on the first line of the code. I tried to add an image of the sheet names.

The forum engine arbitrarily changes the published code.
If you have such a beginning of code

Code:

---

Sub ConsolidateSheets() Dim FileName As String

---

change it to

Code:

---

Sub ConsolidateSheets()
    Dim FileName As String

---

Artik

my tabs are
Plan
Material
Risk Plan
P&ID's

Yes, i did fix this.

Quote:

---

Originally Posted by Artik

The forum engine arbitrarily changes the published code.
If you have such a beginning of code

Code:

---

Sub ConsolidateSheets() Dim FileName As String

---

change it to

Code:

---

Sub ConsolidateSheets()
    Dim FileName As String

---

Artik

---

You claim you have a line of code written like this:

Code:

---

varrSheets = Split("Plan*Material*Risk Plan"P&ID's", "*")

---

Compare with the pattern I gave you.
If you continue to have problems, read the documentation about the Split function. Pay attention to the word/phrase separators that are in the string to be split.
Since the sheet name may contain the "&" character, there can be no problems with copying it because of the name. The problem is how you wrote the Split function. Because cited code is written with an error.
I used an asterisk character especially as a word/phrase separator, becouse it is not allowed in the sheet name.

I also made a little mistake. Line:

Code:

---

If IsSheetExists(wkb, varrSheets(i)) Then

---

you replace with

Code:

---

If IsSheetExists(wkb, CStr(varrSheets(i))) Then

---

Artik