Excel VBA：工作表數組，從一個工作簿復制到另一個

Question

我正在嘗試編寫一個簡單的 VBA 子程序：

1. 在包含代碼的 excel 文件的同一目錄中創建一個新工作簿（“原始文件”從這里開始）
2. 將新工作簿另存為 _export.xlsx
3. 將一些預定義的工作表從原始文件復制到“*_export”一個。

這是我目前所擁有的：

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

代碼似乎一直在運行，直到 Sheets(arrayOfSheetsToCopy).Copy 出現“下標超出范圍”錯誤...最初我雖然在工作表數組的定義中出現了某種語法錯誤，所以我嘗試單獨編寫一個。復制每張工作表的說明。 相同的代碼在相同的點以相同的錯誤中斷。

任何想法？ 謝謝！

Answer 1

Workbook.FullName不返回Workbooks集合的有效參數。

您可以通過在即時 Window 中運行?Workbooks(ActiveWorkbook.FullName).FullName來測試它 - 它會出錯。 另一方面， Workbook.Name確實有效，所以?Workbooks(ActiveWorkbook.Name).FullName不會出錯。 換句話說Workbooks("C:\Users\fabbius\Documents\SomeFile.xlsx")是無效的，而Workbooks("SomeFile.xlsx")是有效的，只要該名稱的文件是打開的。

但是，我看不到使用FullName比使用正確定義的工作簿對象的好處：

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

當然，如果這個宏是從您打算從中導出的工作簿中運行的，那么With和ThisWorkbook會使事情變得更簡單：

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

最后一點：在將工作表添加到文件之前，您正在保存文件。 這些線應該反過來嗎？

Answer 2

這對我有用

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

或者如果您想使用預定義的工作表名稱

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

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

Next sheetName