Combining worksheets with the same name from two different workbooks

Seth2

New Member
Joined
Aug 15, 2016
Messages
5
Hi everyone,

I'm having a hard time trying to combine some data from 2 workbooks (A and B).
What I'm trying to do, is to take the Worksheets with the same name from A and B create a new Workbook with 2 Sheets (Sheet A and Sheet B).
But there are also some other Sheets that don't have a similar name in these 2 Workbooks. So i need to export them into a new workbook by themselves.

Here is my attempt:
Code:
Function createWorkbooks()    Dim wbks(1 To 2) As Workbook
    Dim wbTemp As Workbook
    Dim wsA, wsB As Worksheet
    Dim strPath As String
    Dim intPath, i As Integer
    
    'Select workbooks
    For i = 1 To 2  'loop 2 times to select 2 files
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False   'select 1 file at a time
            intPath = .Show             'show file box
            If intPath <> 0 Then        'verify if a file has been selected
                strPath = .SelectedItems(1) 'select file path
            Else
                MsgBox "Workbook not selected. Exiting."    'if nothing is selected
                Exit Function                               'close
            End If
        End With
        Set wbks(i) = Workbooks.Open(strPath)   'open selected file
    Next i
    'Loop on first file sheets
    For Each wsA In wbks(1).Worksheets
        For Each wsB In wbks(2).Worksheets
            If wsA.Name = wsB.Name Then     'verify if some sheets have the same name
                Set wbTemp = Application.Workbooks.Add  'create wb
                With wbTemp
                    wsA.Copy after:=.Sheets(.Sheets.Count)  'copy sheets into the new file
                    .Sheets(.Sheets.Count).Name = wsA.Name & "-A"   'add the letter A to the first sheet
                    wsB.Copy after:=.Sheets(.Sheets.Count)  'copy sheets into wb
                    .Sheets(.Sheets.Count).Name = wsB.Name & "-B"   'add the letter B to the second
                    'Supprimer les feuilles vides
                    Application.DisplayAlerts = False
                    .Sheets("Sheet1").Delete
                    .Sheets("Sheet2").Delete
                    .Sheets("Sheet3").Delete
                    wbTemp.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
                    wbTemp.Close savechanges:=False
                    Application.DisplayAlerts = True
                End With
            Else
                If Dir(wbks(1).Path & "\" & wsA.Name, vbDirectory) = vbNullString Then
                    wsA.Copy
                    Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
                    Application.ActiveWorkbook.Close False
                End If
                If Dir(wbks(1).Path & "\" & wsB.Name, vbDirectory) = vbNullString Then
                    wsB.Copy
                    Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsB.Name
                    Application.ActiveWorkbook.Close False
                End If
            End If
        Next wsB
    Next wsA


End Function

After executing this function, the program bugs and not all the worksheets are copied.

Hope someone can help me with this.
Thank you !
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,400
Code:
[color=darkblue]Sub[/color] createWorkbooks()
    
    [color=darkblue]Dim[/color] wbks(1 [color=darkblue]To[/color] 2) [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wsA [color=darkblue]As[/color] Worksheet, wsB [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    
    [color=green]'Select workbooks[/color]
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] 2  [color=green]'loop 2 times to select 2 files[/color]
        [color=darkblue]With[/color] Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = [color=darkblue]False[/color]   [color=green]'select 1 file at a time[/color]
            [color=darkblue]If[/color] .Show [color=darkblue]Then[/color]        [color=green]'verify if a file has been selected[/color]
                [color=darkblue]Set[/color] wbks(i) = Workbooks.Open(.SelectedItems(1))   [color=green]'open selected file[/color]
            [color=darkblue]Else[/color]
                MsgBox "Workbook not selected. Exiting."    [color=green]'if nothing is selected[/color]
                [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]                                    [color=green]'close[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]Next[/color] i
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=green]'Loop on first file sheets[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] wsA [color=darkblue]In[/color] wbks(1).Worksheets
        [color=darkblue]If[/color] IsSheet(wbks(2), wsA.Name) [color=darkblue]Then[/color]     [color=green]'if sheet exists in wbks(2)[/color]
            wsA.Copy [color=green]'create wb[/color]
            Sheets(1).Name = wsA.Name & "-A" [color=green]'add the letter A to the first sheet[/color]
            wbks(1).Worksheets(wsA.Name).Copy After:=Sheets(1)  [color=green]'copy sheets into wb[/color]
            Sheets(2).Name = wsA.Name & "-B"   [color=green]'add the letter B to the second[/color]
            ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
            ActiveWorkbook.Close SaveChanges:=[color=darkblue]False[/color]
            counter = counter + 1
        [color=darkblue]Else[/color] [color=green]'if sheet doesn't exist in wbks(2)[/color]
            [color=darkblue]If[/color] Dir(wbks(1).Path & "\" & wsA.Name, vbDirectory) = vbNullString [color=darkblue]Then[/color]
                wsA.Copy
                Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
                Application.ActiveWorkbook.Close [color=darkblue]False[/color]
                counter = counter + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] wsA
    
    [color=green]'Loop on second file sheets[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] wsB [color=darkblue]In[/color] wbks(2).Worksheets
        [color=darkblue]If[/color] [color=darkblue]Not[/color] IsSheet(wbks(1), wsB.Name) [color=darkblue]Then[/color]     [color=green]'if sheet doesn't exist in wbks(1)[/color]
            [color=darkblue]If[/color] Dir(wbks(1).Path & "\" & wsB.Name, vbDirectory) = vbNullString [color=darkblue]Then[/color]
                wsB.Copy
                Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsB.Name
                Application.ActiveWorkbook.Close [color=darkblue]False[/color]
                counter = counter + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] wsB
    
    wbks(1).Close [color=darkblue]False[/color]
    wbks(2).Close [color=darkblue]False[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    MsgBox counter & " workbooks saved.", , "Create Workbooks Complete"
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]


[color=darkblue]Function[/color] IsSheet(wb [color=darkblue]As[/color] Workbook, strSheetName [color=darkblue]As[/color] [color=darkblue]String[/color]) [color=darkblue]As[/color] [color=darkblue]Boolean[/color]
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    IsSheet = LCase(wb.Sheets(strSheetName).Name) = LCase(strSheetName)
[color=darkblue]End[/color] [color=darkblue]Function[/color]
 

Seth2

New Member
Joined
Aug 15, 2016
Messages
5
Thank you a lot AlphaFrog :)

The program works great, except for 2 or 3 sheets. :confused:

Here is an example of A and B files to illustrate the problem:
A : https://ufile.io/7c55b
B : https://ufile.io/85cd2

At the end of the execution, there are some sheets that have the same name, but have been saved into 2 different Worbooks, I can't figure out why :confused:
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,400
Some sheet names have a trailing space e.g.;
"Energy Industrie "
versus
"Energy Industrie"
 

Seth2

New Member
Joined
Aug 15, 2016
Messages
5
You're right, it seems to work now !
Thanks again AlphaFrog ! :) :)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,343
Messages
5,635,736
Members
416,874
Latest member
MichaelaTanner

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
Top