Thread: Append multiple workbooks with multiple worksheets

Hi,

I would like to append multiple workbooks with multiple worksheets in a separate workbook. For eg. I have workbook "A" with sheets 1,2,3 and workbook "B" with sheets 4,5,6. Now I want to append "A" and "B" to create workbook "C" with sheets 1,2,3,4,5,6.

Thank you in advance.

This is just a repost to my earlier question. I realize people in this forum are very busy and don't have time to go through each and every thread. But I would be very grateful for any kind of help on this matter.

Thanking you again.

Open Workbook A and save it as Workbook C.

With Workbook C still open, open Workbook B. Select all the sheets, and do Edit > Move or Copy Sheet, tick Make a copy, and select Workbook C from the dropdown.

Thank you for the quick response but I wanted to write a macro. I apologize for not mentioning it in my earlier post.

Actually, I should have noticed that you were in the Programming forum.

Why don't you start by recording a macro doing it, and then we'll clean it up from there?

Please read the Forum Rules about Code Tags. I've edited your post to correct them.

I'm still trying to figure it out but with no success. Any ideas??

Sub test()


Dim NewBook As Workbook
Set NewBook = Workbooks.Add
With NewBook
.Title = "Master Sheet"
.SaveAs Filename:="Masterdb.xls"
End With

Dim FD As FileDialog
Dim FFS As FileDialogFilters

'On Error GoTo Problem

Set FD = Application.FileDialog(msoFileDialogOpen)

With FD
Set FFS = .Filters
    With FFS
    .Clear
   ' .Add ".xls"
    End With

.AllowMultiSelect = True

Dim IntCounter As Integer
Dim Item

IntCounter = 1

For Each Item In .SelectedItems

Sheets(Array(Sheets.Count - 1)).Copy after:=Sheets(Sheets.Count)
'NewBook.Sheets.Add after:=Sheets(Sheets.Count)
IntCounter = IntCounter + 1
Next Item
End With
'End Sub

'Problem:
'MsgBox "problem"
End Sub

Try this:

Sub sam10()
    Dim wkbMst  As Workbook     ' master
    Dim wkbInp  As Workbook     ' input workbook
    Dim wks     As Worksheet    ' worksheets in input workbooks
    
    Dim sFile   As String
    Dim bRept   As Boolean
    Dim nWks    As Long
    Dim iWks    As Long

    sFile = Application.GetSaveAsFilename(FileFilter:="Excel files, *.xls", _
                                          Title:="Master Workbook")
    If sFile = "False" Then Exit Sub
    
    Set wkbMst = Workbooks.Add
    nWks = wkbMst.Sheets.Count
    wkbMst.SaveAs sFile
    
    sFile = Application.GetOpenFilename
    Application.EnableEvents = False    ' disable macros in workbooks to be opened
    
    Do While sFile <> "False"
        Set wkbInp = Workbooks.Open(sFile)
        For Each wks In wkbInp.Worksheets
            wks.Copy After:=wkbMst.Sheets(wkbMst.Sheets.Count)
        Next wks
        
        If Not bRept Then
            ' delete the original sheets in the blank workbook
            Application.DisplayAlerts = False
            For iWks = 1 To nWks
                wkbMst.Worksheets(1).Delete
            Next iWks
            Application.DisplayAlerts = True
            bRept = True
        End If
        
        wkbInp.Close SaveChanges:=False
        wkbMst.Save
        sFile = Application.GetOpenFilename
    Loop
    
    Application.EnableEvents = True
End Sub

I got it to work. Thanks Shg.