I have used this
code to
combine several
Workbooks. Each Workbook must be open for it to work. I only use to gather
Timesheets from several employees (one
sheet per
book) into one Workbook
Sub
Combine()
Dim NewFileName As String
Dim c As Integer
Dim SheetCount As Integer
NewFileName =
ActiveWorkbook.
Name
c = 1
Do Until c = 0
If Windows(c).Visible = True Then
Windows(c).Activate
MsgBox ("New file to be created")
NewFileName = Application.GetSaveAsFilename _
(, "Microsoft Excel Workbook (*.xls),*.xls")
ActiveWorkbook.
SaveAs FileName:=NewFileName, _
FileFormat:=xlWorkbookNormal
NewFileName = ActiveWorkbook.Name
ActiveSheet.Select
c = 0
SheetCount = ActiveWorkbook.Sheets.Count
Else
c = c + 1
End If
Loop
For c = 1 To
Workbooks.Count
If Windows(c).Parent.Name <> NewFileName And Windows(c).Visible = True Then
Windows(c).Activate
ActiveWorkbook.Sheets.Copy after:=Workbooks(NewFileName).Sheets(SheetCount)
End If
Next c
End Sub