宏將數據從一個工作簿複製到特定文件夾中的所有其他工作簿

Question

我需要將主項目列表從一個工作簿複製到特定文件夾中的所有其他工作簿。我已經嘗試過 - 請參閱下面的宏。雖然宏不給我任何錯誤，我也無法讓它工作...有人可以幫忙嗎？

在此先感謝！

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 

Answer 1

試試這個：

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