LINNANDA
asked on
Coding solution using Excel VBA, copying multiple workbooks into a single one without know the name of each workbook
Hi,
Each month 50 workbooks are downloaded into a folder, say C:\download\, the number of workbooks vary as does the their names , however the names are always in the same format - batch no. xxxx.xls, so for example
one month you might get
batch no.1234
batch no 1235
batch no. 1254
etc
and the following month it might be
batch no. 2245
batch no. 2345
batch no. 3456
etc
Each batch no workbook only contains 1 worksheet.
I've got my hands on a program which transfers all the sheets into one workbook and then transfers it onto a second workbook and into a single sheet.
However for this to work the batch no. xxxx.xls files must be opened.
Since having 50 open workbooks makes the process extremely slow is there a way of not having to open the work books
but still transfer them onto a single work book.
Here's the code I'm currently using:
-------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
Sub CombineAllOpenWorkbooks_1( )
Dim NewFileName As String
Dim c As Integer
Dim SheetCount As Integer
Dim J 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.GetSaveAsFilen ame _
(, "Microsoft Excel Workbook (*.xls),*.xls")
ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlWorkbookNorm al
NewFileName = ActiveWorkbook.Name
ActiveSheet.Select
c = 0
SheetCount = ActiveWorkbook.Sheets.Coun t
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(NewFileNa me).Sheets (SheetCoun t)
End If
Next c
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Sele ct
Selection.Copy Destination:=Sheets(1).Ran ge("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Se lect ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.C ount - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Ran ge("A65536 ").End(xlU p)(2)
Next
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom , _
DataOption1:=xlSortNormal
Sheets("Combined").Select
Range("A2:Z10000").Select
Selection.Copy
Workbooks.Open Filename:= _
"U:\Transfer\Management fee batch generation DEC 04\breakdown1.xls"
ActiveSheet.Paste
Range("A2").Select
End Sub
Any ideas as to how I might do this?
Each month 50 workbooks are downloaded into a folder, say C:\download\, the number of workbooks vary as does the their names , however the names are always in the same format - batch no. xxxx.xls, so for example
one month you might get
batch no.1234
batch no 1235
batch no. 1254
etc
and the following month it might be
batch no. 2245
batch no. 2345
batch no. 3456
etc
Each batch no workbook only contains 1 worksheet.
I've got my hands on a program which transfers all the sheets into one workbook and then transfers it onto a second workbook and into a single sheet.
However for this to work the batch no. xxxx.xls files must be opened.
Since having 50 open workbooks makes the process extremely slow is there a way of not having to open the work books
but still transfer them onto a single work book.
Here's the code I'm currently using:
--------------------------
Sub CombineAllOpenWorkbooks_1(
Dim NewFileName As String
Dim c As Integer
Dim SheetCount As Integer
Dim J 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.GetSaveAsFilen
(, "Microsoft Excel Workbook (*.xls),*.xls")
ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlWorkbookNorm
NewFileName = ActiveWorkbook.Name
ActiveSheet.Select
c = 0
SheetCount = ActiveWorkbook.Sheets.Coun
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
End If
Next c
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Sele
Selection.Copy Destination:=Sheets(1).Ran
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Se
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.C
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Ran
Next
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
DataOption1:=xlSortNormal
Sheets("Combined").Select
Range("A2:Z10000").Select
Selection.Copy
Workbooks.Open Filename:= _
"U:\Transfer\Management fee batch generation DEC 04\breakdown1.xls"
ActiveSheet.Paste
Range("A2").Select
End Sub
Any ideas as to how I might do this?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks for that miswmf.
It's working fine now.