macros将数据从一个工作簿复制到特定文件夹中的所有其他工作簿

我需要将主项目列表从一个工作簿复制到特定文件夹中的所有其他工作簿。 我已经尝试 – 看到我的macros下面。 虽然macros不给我任何错误,我也无法得到它的工作…有人可以帮忙吗?

提前致谢!!

Sub Macro1() Dim MyObj As Object, MySource As Object, file As Variant file = Dir("C:\Users\New folder") While (file <> "") Workbooks("Master Project list (2).xlsx").Sheets("Master Project list").Range("A1:D34").Select Selection.Copy Windows(file).Activate Sheets("Master Project list").Range("A1").Select Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Paste Exit Sub file = Dir Wend End Sub 

试试这个:

 Sub Macro1() Dim file As String Dim myPath As String Dim wb As Workbook Dim rng As Range Dim wbMaster As Workbook 'if master workbook already opened Set wbMaster = Workbooks("Master Project list (2).xlsx") 'if master workbook is not opened 'Set wbMaster = Workbooks.Open("C:\Users\New folder\Master Project list (2).xlsx") Set rng = wbMaster.Sheets("Master Project list").Range("A1:D34") myPath = "C:\Users\New folder\" ' note there is a back slash in the end file = Dir(myPath & "*.xls*") While (file <> "") Set wb = Workbooks.Open(myPath & file) rng.Copy With wb.Worksheets("Master Project list").Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteAll End With wb.Close SaveChanges:=True Set wb = Nothing file = Dir Wend Application.CutCopyMode = False End Sub