Link to home
Start Free TrialLog in
Avatar of LINNANDA
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.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
   
 
   
    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.Select
    Selection.Copy Destination:=Sheets(1).Range("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.Select ' select all cells in this sheets

        ' select all lines except title
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(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?
ASKER CERTIFIED SOLUTION
Avatar of miswmf
miswmf

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of LINNANDA
LINNANDA

ASKER


Thanks for that miswmf.

It's working fine now.