Excel VBA: array of Sheets, Copy from one Workbook to another

Question

I'm trying to write a simple VBA Subroutine that:

1. creates a new workbook in the same directory of the excel file that contains the code ("original file" from here onward)
2. saves the new workbook as _export.xlsx
3. copies some predefined sheets from the original file to the "*_export" one.

This is what I've got at the time being:

Sub export()

Dim myPath, folderPath, fileName, exportFileFullPath As String
Dim arrayOfSheetsToCopy As Variant

folderPath = Application.ActiveWorkbook.Path
fullPath = Application.ActiveWorkbook.FullName
fileName = Replace(Application.ActiveWorkbook.Name, ".xlsm", "")

exportFileFullPath = folderPath & "\" & fileName & "_export.xlsx"

Workbooks.Add
ActiveWorkbook.SaveAs fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

arrayOfSheetsToCopy = Array("originalSheet1", "originalSheet2", "originalSheet3")

Workbooks(fullPath).Sheets(arrayOfSheetsToCopy).Copy After:=Workbooks(exportFileFullPath).Sheets(Sheets.Count)

End Sub

The code seems to run until a "Subscript out of range" error at Sheets(arrayOfSheetsToCopy).Copy... Initially I though to some kind of syntax error in the definition of the Array of Sheets, so I tried to write a separate .Copy instruction for each Sheet. The same code interrupts at the same point with the same error.

Any idea? Thank you!

Answer 1

Workbook.FullName does not return a valid argument for the Workbooks collection.

You can test this by running ?Workbooks(ActiveWorkbook.FullName).FullName in the Immediate Window - it will error. On the other hand, Workbook.Name does work, so ?Workbooks(ActiveWorkbook.Name).FullName will not error. In other words Workbooks("C:\Users\fabbius\Documents\SomeFile.xlsx") is not valid, while Workbooks("SomeFile.xlsx") is valid, so long as a file by that name is open.

However, I fail to see the benefit of using FullName over using properly defined Workbook Objects:

Sub export()
    Dim exportFileFullPath As String, arrayOfSheetsToCopy As Variant
    Dim wsExportFrom As Workbook, wsExportTo As Workbook
    
    Set wsExportFrom = ActiveWorkbook
    Set wsExportTo = Workbooks.Add
    
    exportFileFullPath = Replace(wsExportFrom.FullName, ".xlsm", "_export.xlsx", Len(wsExportFrom.Path))
    'The Len() is in case the File Path contains ".xlsm" for some reason
    
    wsExportTo.SaveAs fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
    arrayOfSheetsToCopy = Array("originalSheet1", "originalSheet2", "originalSheet3")
    
    wsExportFrom.Sheets(arrayOfSheetsToCopy).Copy after:=wsExportTo.Sheets(wsExportTo.Sheets.Count)
End Sub

Of course, if this Macro is being run from the workbook you intend to export from, then With and ThisWorkbook make things even simpler:

Sub export()
    Dim exportFileFullPath As String, arrayOfSheetsToCopy As Variant
    
    exportFileFullPath = Replace(ThisWorkbook.FullName, ".xlsm", "_export.xlsx", Len(ThisWorkbook.Path))
    'The Len() is in case the File Path contains ".xlsm" for some reason

    arrayOfSheetsToCopy = Array("originalSheet1", "originalSheet2", "originalSheet3")

    With Workbooks.Add
        
        .SaveAs fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
        ThisWorkbook.Sheets(arrayOfSheetsToCopy).Copy after:=.Sheets(.Sheets.Count)
    
    End With
End Sub

Final note: You are saving the file before you add the worksheets to it. Should those lines be the other way around?

Answer 2

This works for me

Sub export()

    Dim myPath, folderPath, fileName, exportFileFullPath As String
    Dim arrayOfSheetsToCopy As Variant
    Dim sht As Worksheet
    Dim newWorkBook As Workbook
    
    
    folderPath = Application.ActiveWorkbook.Path
    fullPath = Application.ActiveWorkbook.FullName
    fileName = Replace(Application.ActiveWorkbook.Name, ".xlsm", "")
    fileName = Replace(fileName, ".xlsx", "")
    
    exportFileFullPath = folderPath & "\" & fileName & "_export.xlsx"
    
    Set newWorkBook = Workbooks.Add
    
    Call newWorkBook.SaveAs(fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False)
    
    For Each sht In ThisWorkbook.Sheets
    
        Call sht.Copy(after:=newWorkBook.Sheets(Sheets.Count))
    
    Next sht
    
    Call newWorkBook.Close(saveChanges:=True)

End Sub

or if you want to use predefined sheetnames

For Each sheetName In Array("originalSheet1", "originalSheet2", "originalSheet3")

    Call ThisWorkbook.Sheets(sheetName).Copy(after:=newWorkBook.Sheets(Sheets.Count))

Next sheetName