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

时间:2014-02-26 18:08:42

标签: excel vba excel-vba

我需要将一个主项目列表从一个工作簿复制到特定文件夹中的所有其他工作簿。我试过 - 看下面我的宏。虽然宏没有给我任何错误,但我也无法让它工作......有人可以帮忙吗?

提前致谢!!

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

1 个答案:

答案 0 :(得分:2)

试试这个:

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