[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2110
  • Last Modified:

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?
0
LINNANDA
Asked:
LINNANDA
1 Solution
 
miswmfCommented:
This might help you combine the workbooks into one workbook more quickly, but the quickest way to do this is probably to open up each workbook one at a time then copy the information from that workbook to the master worksheet.  That way you are not doing two copies.

For this example 'master.xls' is your master workbook that was open when I ran the macro.  Also, I added a reference to the Microsoft Scripting Runtime object.  This example only has at most two workbooks open at a time which might make things run more quickly.  

Sub CombineWorkbooks()

    Dim fso As New FileSystemObject
    Dim Folder As Folder
    Dim File As File
   
    Set Folder = fso.GetFolder("C:\Download\")
   
    For Each File In Folder.Files
        If UCase$(Right(File.ShortName, 3)) = "XLS" Then
            Workbooks.Open FileName:=File.Name
            Sheets(1).Copy After:=Workbooks("master.xls").Sheets(Workbooks("master.xls").Sheets.Count)
            Workbooks(File.ShortName).Close
        End If
    Next File
   
    Set File = Nothing
    Set Folder = Nothing
    Set fso = Nothing
   
End Sub
0
 
LINNANDAAuthor Commented:

Thanks for that miswmf.

It's working fine now.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now