将多个工作表中的数据复制到多个工作簿

时间:2013-06-03 14:09:23

标签: excel-vba vba excel

我正在尝试将excel文件中多个工作表中的数据复制到其中包含模板的多个文件中。因此,一个excel文件有1500个具有唯一名称的工作表,并且存在1500个与工作表同名的excel文件。我正在尝试将数据(通常为A1:A50)从每个工作表复制到另一个同名文件。目标excel文件中有两个工作表,这些数据需要进入每个工作表:“内页”中的单元格B5:B55,“后页”中的单元格C5:C55。

非常感谢任何帮助!

拉​​莉莎

1 个答案:

答案 0 :(得分:1)

这应该让你开始。如果您有1500(!)工作表,唯一的问题可能是性能。

Option Explicit
Public Sub splitsheets()
    Dim srcwb As Workbook, trgwb As Workbook
    Dim ws As Worksheet, t1ws As Worksheet, t2ws As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim trgnm As String
    Dim fpath As String

    Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
    fpath = "H:/copytest/"

    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:B3")
'--> Change C4:D5 to the range to be copied to outside page
        Set rng2 = srcwb.Sheets(trgnm).Range("C4:D5")

        Set trgwb = Workbooks.Open(fpath & trgnm & ".xls")
        With trgwb
            Set t1ws = .Sheets("Inside Page")
            Set t2ws = .Sheets("Outside Page")
        End With
'--> Change A1:B3 to the range where you want to paste
        rng1.Copy t1ws.Range("A1:B3")
'--> Change C4:D5 to the range where you want to paste
        rng2.Copy t2ws.Range("C4:D5")
        trgwb.Close True
    Next
    Application.ScreenUpdating = True
End Sub