我有一个包含一个工作表(“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”在该目录中不存在(它不存在)。
非常感谢任何帮助。
答案 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
请注意,我没有添加错误处理,因此如果活动工作簿包含在您尝试复制的目录中,或者工作簿中已存在具有相同名称的工作表,则可能会中断。如果这是一个问题,请告诉我,我将添加错误处理。