将部分 Excel 工作簿复制/粘贴到当前未打开的工作簿中

Question

我需要将 Excel 工作簿的一部分复制到大约 3500 个其他工作簿。由于工作簿的数量，在每个工作簿上运行宏是不可行的。

有没有办法在不打开它们的情况下复制该片段并将其粘贴到其他工作簿？

Answer 1

番茄， 不幸的是，正如@Ken White 和@L42 都指出的那样，为了编辑文件，您必须至少在某种程度上打开它（即将它加载到内存中）。更糟糕的是，除非您愿意直接操作 xml 或二进制数据（不建议），否则您将不得不使用 Excel 为您打开 .xlsx 文件，这需要时间。

当然，这并不意味着您必须手动输入。例如：

Sub DataToOtherWorkbooks()
    Dim StrFile As String
    Dim SourceRange As Range
    Rng = "A1:A2"
    Set SourceRange = Range(Rng)

    StrFile = Dir("C:\ExcelWorkBooks\*.xlsx")
    Do While Len(StrFile) > 0
        Debug.Print StrFile
        Application.ScreenUpdating = False
        Set TargetWb = Workbooks.Open("C:\ExcelWorkBooks\" & StrFile)
        TargetWb.Worksheets("Sheet1").Range(Rng).Value(11) = SourceRange.Value(11)
        TargetWb.Save
        TargetWb.Close SaveChanges:=False
        StrFile = Dir
    Loop
End Sub

上述代码将遍历文件夹 ExcelWorkBooks 中扩展名为 .xlsx 的所有文件，并使用位于源工作簿指定范围内的数据填充它们。

但是，如前所述，这需要一些时间。当我在 100 个工作簿（从我的笔记本电脑）上运行它时，每个工作簿平均需要 0.54 秒。因此，在您的情况下，您查看 3,500 个工作簿大约需要 31 分钟。不完全是光速，但肯定比手工完成要好。希望这对你有用。如果您还有其他问题，请询问。

补充

番茄，响应您的评论，转移格式，包括您将使用的范围内单元格的合并或未合并性质：

TargetWb.Worksheets("Sheet1").Range(Rng).Value(11) = SourceRange.Value(11)

我已更新原始代码以反映更改。这应该会为您解决问题，但请告诉我。