Combine specific sheets from multiple workbooks into 1 workbook.

[RhonKiser]

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.

[jolivanes]

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?

[jolivanes]

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

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

[Artik]

Another version
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 FunctionArtik

[RhonKiser]

Another version
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 FunctionArtik

[Artik]

And how did you write this line
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

[RhonKiser]

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

[Artik]

If your sheet name contains quotation marks, you must duplicate each character to create a string for the Split function:
varrSheets = Split("Plan*Material*Risk Plan""P&ID's""", "*") if the last sheet name is Risk Plan"P&ID's".

Artik

[RhonKiser]

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.

[Artik]

The forum engine arbitrarily changes the published code.
If you have such a beginning of code
Sub ConsolidateSheets() Dim FileName As String change it to
Sub ConsolidateSheets()
Dim FileName As String

Artik

[RhonKiser]

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

[RhonKiser]

Yes, i did fix this.


The forum engine arbitrarily changes the published code.
If you have such a beginning of code
Sub ConsolidateSheets() Dim FileName As String change it to
Sub ConsolidateSheets()
Dim FileName As String

Artik

[Artik]

You claim you have a line of code written like this:
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:

If IsSheetExists(wkb, varrSheets(i)) Then
you replace with
If IsSheetExists(wkb, CStr(varrSheets(i))) Then

Artik