Saving .xls file created on the fly

TUSSFC

Registered User.
Local time
Today, 05:44
Joined
Apr 12, 2007
Messages
57
I'm using the bit of code below to combine the first worksheet of every workbook in a specific directory into a single workbook with multiple worksheets. This works OK so far, the only thing I'd like to add is to Save the resulting xls file into either the same directory or another specific directory (doesn't matter, as long as I can have it autosave somewhere). Any ideas?

At present it just opens the resultant xls file ...

Code:
Function Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

Dim objExcel As Excel.Application
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

    objExcel.DisplayAlerts = False
    objExcel.EnableEvents = False
    objExcel.ScreenUpdating = False
    
    MyPath = "C:\Outputs" ' change to suit
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(MyPath & "\*.xls", vbNormal)
    
    If Len(strFilename) = 0 Then Exit Function
    
    Do Until strFilename = ""
        
            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
            
            Set wsSrc = wbSrc.Worksheets(1)
            
            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
            
            wbSrc.Close False
        
        strFilename = Dir()
        
    Loop
    
    wbDst.Worksheets(1).Delete
    
    objExcel.DisplayAlerts = True
    objExcel.EnableEvents = True
    objExcel.ScreenUpdating = True

Set objExcel = Nothing
Set wbDst = Nothing
Set wbSrc = Nothing
Set wsSrc = Nothing
    
End Function
 
Last edited:
Sorted, wbDst.SaveAs FileName:=strNewWorkbook did it :-)
 

Users who are viewing this thread

Back
Top Bottom