Bring only first sheets together on the same workbook

erdow

New Member
Joined
May 30, 2021
Messages
28
Office Version
  1. 365
Platform
  1. Windows
Hi to all experts,

I found this code on the net and its exactly what i need except only one detail.
When i run the code it bring all sheets of the workbooks which i chose but i need only the first shett of the books. Can anyone fix it please.


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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Please be sure to use code tags when posting. It makes it much easier for us to read and follow the code.
See: How to Post Your VBA Code

Note that the variable declaration in that code is a bit faulty. Lines like this:
VBA Code:
Dim wbkCurBook, wbkSrcBook As Workbook
do NOT declare both as Workbook. Only the second will be declared as a Workbook. The first will be declared as variant.
That is because each variable needs to be declared individually, or it defaults to Variant.

That line should be corrected to look like this:
VBA Code:
Dim wbkCurBook As Workbook, wbkSrcBook As Workbook
It shouldn't affect how this code runs, but it is helpful in debugging (and if you are going to declare variables, it is best to pick the most appropriate type instead of the "catch all" Variant).

So, if you want to just copy over the first sheet, maybe try something like this (I did not have the opportunity to test this, so hope it works):
VBA Code:
Sub MergeExcelFiles()

    Dim fnameList As Variant, fnameCurFile As Variant
    Dim countFiles As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook As Workbook, 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

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1

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

                wbkSrcBook.Sheets(1).Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

                wbkSrcBook.Close SaveChanges:=False

            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & countFiles & " files", Title:="Merge Excel files"
        End If

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

End Sub
 
Upvote 0
Solution
Please be sure to use code tags when posting. It makes it much easier for us to read and follow the code.
See: How to Post Your VBA Code

Note that the variable declaration in that code is a bit faulty. Lines like this:
VBA Code:
Dim wbkCurBook, wbkSrcBook As Workbook
do NOT declare both as Workbook. Only the second will be declared as a Workbook. The first will be declared as variant.
That is because each variable needs to be declared individually, or it defaults to Variant.

That line should be corrected to look like this:
VBA Code:
Dim wbkCurBook As Workbook, wbkSrcBook As Workbook
It shouldn't affect how this code runs, but it is helpful in debugging (and if you are going to declare variables, it is best to pick the most appropriate type instead of the "catch all" Variant).

So, if you want to just copy over the first sheet, maybe try something like this (I did not have the opportunity to test this, so hope it works):
VBA Code:
Sub MergeExcelFiles()

    Dim fnameList As Variant, fnameCurFile As Variant
    Dim countFiles As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook As Workbook, 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

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1

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

                wbkSrcBook.Sheets(1).Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

                wbkSrcBook.Close SaveChanges:=False

            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & countFiles & " files", Title:="Merge Excel files"
        End If

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

End Sub
Perfectly works, thanks a lot. :)
 
Upvote 0
You are welcome.
Glad it worked out for you!
:)
 
Upvote 0

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,094
Latest member
teemeren

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