使用VBA将一个工作表复制到多个相同的工作簿

时间:2013-06-10 23:51:16

标签: excel-vba vba excel

我有一个包含一个工作表(“DB Output”或Sheet 34)的工作簿,我想将其复制到同一文件夹中的几个(大约45个)文件中。

目标文件都没有名为“数据库输出”的现有工作表 - 目的是找到一种方法将此工作表的副本,forumlas和all插入每个工作表。

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

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

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

同样地,我已经针对类似的情况查看了SO,this是最接近的,但是我尝试调整该代码的尝试失败了,因为我只有一个工作片。从来没有,因为包含你已经尝试过的东西总是有用的,这是我现有的尝试:

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 Output(要复制的工作表)的工作簿中的第一个工作表开始,并给出一个错误:“NameOfSheet1.xlsm”在该目录中不存在(它不存在)。

非常感谢任何帮助。

1 个答案:

答案 0 :(得分: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

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