1

我有一个包含一个工作表（“DB 输出”或 Sheet 34）的工作簿，我想将其复制到同一个文件夹中的几个（大约 45 个）文件中。

没有一个目标文件有一个名为“DB Output”的现有工作表 - 目标是找到一种方法将这个工作表的副本、forumlas 和所有文件插入到每个文件中。

该工作表上需要复制到每本书同名工作表的单元格范围是A1：PE5

该工作表包含对当前所在书中单元格的引用，但是由于我试图将工作表复制到所有文件共享相同的模板，我希望引用是本地文件，而不是原始文件。

我试过查看 RDBMerge，但它似乎是用于合并工作表，虽然我确实想这样做，但它不会帮助我快速多次完成。

同样，我在类似的情况下查看了 SO，这是最接近的，但是我尝试调整该代码失败了，因为我只有一个工作组。无论如何，包括你已经尝试过的东西总是有用的，这是我现有的尝试：

Option Explicit
Public Sub splitsheets()
    Dim srcwb As Workbook, trgwb As Workbook
    Dim ws As Worksheet, t1ws As Worksheet
    Dim rng1 As Range
    Dim trgnm As String
    Dim fpath As String

    Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
    fpath = "C:/file/path/"

    Set srcwb = ThisWorkbook
    For Each ws In srcwb.Worksheets
        trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
        Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")

        Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
        With trgwb
            Set t1ws = .Sheets("DB Output")
        End With
'--> Change A1:B3 to the range where you want to paste
        rng1.Copy t1ws.Range("A1:PE5")

        trgwb.Close True
    Next
    Application.ScreenUpdating = True
End Sub

但是，这从工作簿中包含 DB 输出（要复制的工作表）的第一个工作表开始，并给出一个错误，即该目录中不存在“NameOfSheet1.xlsm”（它不存在）。

任何帮助深表感谢。

4

1 回答 1

2

这应该从活动工作簿复制到目录中的所有文件。如果您需要帮助修改它以适合您的特定用途，请告诉我！

编辑：固定代码仅复制 A1:PE5 并保存每个工作簿。

Sub Example()
    Dim path As String
    Dim file As String
    Dim wkbk As Workbook

    path = "C:\Test\"
    file = Dir(path)

    Application.DisplayAlerts = False

    Do While Not file = ""
        Workbooks.Open (path & file)
        Set wkbk = ActiveWorkbook
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "DB Output"
        ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
        wkbk.Save
        wkbk.Close
        file = Dir
    Loop

    Application.DisplayAlerts = True

End Sub

请注意，我没有添加错误处理，因此如果活动工作簿包含在您尝试复制的目录中，或者如果工作簿中已存在同名工作表，这可能会中断。如果这是一个问题，请告诉我，我将添加错误处理。

于 2013-06-11T00:12:14.013 回答