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