Consolidating many workbooks into one
Posted by Susan on February 02, 2002 9:07 AM
I hope someone can help. I am trying to write a macro that will accumulate or consolidate all open workbooks into one. It would be like using the "move or copy sheet" function but would combine all sheets of all open (AND UNHIDDEN-i.e.not personal.xls running in background) workbooks at the same time. Ideally, I am thinking copy all open sheets to a new workbook-but I will work with any ideas!!
Thanks in advance!
Posted by Barrie Davidson on February 02, 2002 10:14 AM
Susan, this code should do what you need:
Sub CombineAllOpenWorkbooks()
' Macro written by Barrie Davidson
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
Regards,
BarrieBarrie Davidson
Posted by Susan on February 02, 2002 11:08 AM
This is great-thanks very much for your help!!
