Question

我正在尝试将一个表格从源Excel工作簿复制到大约750个其他布置相同的工作簿中（它们没有相同名称的工作表）。

我找到了一段应该执行此操作的代码：

Option Explicit
Public Sub CopySheetToAllWorkbooksInFolder()
    Dim sourceSheet As Worksheet
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook

    'Worksheet in active workbook to be copied as a new sheet to the destination woorkbook

    Set sourceSheet = ActiveWorkbook.Worksheets("Sheet1")

    'Folder containing the destination workbooks

    folder = "F:\temp\excel\"

    filename = Dir(folder & "*.xls", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.Close True
        filename = Dir()  ' Get next matching file
    Wend
End Sub

我已将其复制到工作表模块中，并修改了我认为需要更改的元素，如下所示：

Option Explicit

Public Sub CopySheetToAllWorkbooksInFolder()

    Dim sourceSheet As Worksheet
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook

    'Worksheet in active workbook to be copied as a new sheet to the destination workbook

    Set sourceSheet = ActiveWorkbook.Worksheets("Edit")

    'Folder containing the destination workbooks

    folder = "M:\Employee Information\Peter Young\Msc Project\1 - 181028 - Office First Floor\Test\"

    filename = Dir(folder & "*.xls", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.Close True
        filename = Dir()  ' Get next matching file
    Wend
End Sub

当我单击“运行”时，出现“宏”对话框，再次单击“运行”，该框消失并且什么也没有发生。

当我在源工作簿中运行宏时，什么也没发生。

当我在其中一个目标工作簿中运行时，出现下标超出范围错误。（我正在使用Excel 2013。）

Answer 1

当您收到错误消息时，请按调试按钮，然后检查错误发生的位置...这是找出代码中正在发生的情况的常用方法。

在这种情况下，我最好的猜测是您的文件是.xlsx而不是.xls吗？

如果是这种情况，请相应地修改此行filename = Dir(folder & "*.xls", vbNormal)

编辑

要补充一个问题，正如Nathan所指出的，取决于您的代码，从何处运行宏确实很重要，在这种情况下，假设Set sourceSheet = ActiveWorkbook.Worksheets("Edit")指向您的ActiveWorkbook，那么您的运行宏时，源应为ActiveWorkbook。

使用ThisWorkbook也是一种解决方案，但是取决于您要对代码执行什么操作，而并非总是理想的代码。

还可以使用如下名称来命名工作簿：Workbooks("YourSourceWorkbookName.xlsm").Sheets("Edit")，然后从哪里运行代码都无关紧要（至少在这种情况下）。

将单个工作表复制到多个工作簿

1 个答案: