复制并粘贴下一个Excel工作表VBA

时间：2015-06-24 19:50:32

标签： excel vba excel-vba copy-paste

我是VBA的完全初学者，我查看了其他主题，但无法找到答案（至少我能理解）。

基本上我在研究项目中有不同科目的Excel工作簿。

我想复制主题工作簿中的一些数据，然后将其传递给主工作簿。此代码适用于一个主题。

打开选定的工作簿，复制到正确位置所需的内容然后关闭它然后打开下一个条件等。

我想找个方法告诉它打开下一个工作簿（即：Patient1GlobalP.xlsm变为Patient2GlobalP.xlsm，然后是3然后4 ......）并执行相同操作但复制到下一个单元格（复制的范围保持不变，但复制目的地的Range("C2").Select变为Range("D2").Select，C1509变为D1509，C3016变为D3016，然后是E，然后是F ......）。我可以手工完成，但必须有更优雅的解决方案，如某种偏移。 

Windows("Patient1GlobalP.xlsm").Activate
    Range("B1:B1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle X").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1GlobalP.xlsm").Activate
    Range("C1:C1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle Y").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1GlobalP.xlsm").Activate
    Windows("Patient1GlobalP.xlsm").Activate
    Range("C1:C1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle Z").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1GlobalP.xlsm").Activate
    Range("N1:N1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee X").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1GlobalP.xlsm").Activate
    Range("O1:O1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee Y").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1GlobalP.xlsm").Activate
    Range("P1:P1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee Z").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1GlobalP.xlsm").Activate
    Range("I1:I1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip X").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1GlobalP.xlsm").Activate
    Range("J1:J1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip Y").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1GlobalP.xlsm").Activate
    Range("J1:J1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip Z").Select
    Range("C2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
Workbooks.Open Filename:="C:\Users\hugo\Desktop\data\Patient1LocalP.xlsx"
    Windows("Patient1LocalP.xlsx").Activate
    Range("B1:B1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle X").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1LocalP.xlsx").Activate
    Range("C1:C1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle Y").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1LocalP.xlsx").Activate
    Windows("Patient1LocalP.xlsx").Activate
    Range("C1:C1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle Z").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1LocalP.xlsx").Activate
    Range("N1:N1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee X").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1LocalP.xlsx").Activate
    Range("O1:O1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee Y").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1LocalP.xlsx").Activate
    Range("P1:P1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee Z").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1LocalP.xlsx").Activate
    Range("I1:I1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip X").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1LocalP.xlsx").Activate
    Range("J1:J1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip Y").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1LocalP.xlsx").Activate
    Range("J1:J1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip Z").Select
    Range("C1509").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1LocalP.xlsx").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Users\hugo\Desktop\data\Patient1Nopert.xlsx"
    Windows("Patient1Nopert.xlsx").Activate
    Range("B1:B1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle X").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1Nopert.xlsx").Activate
    Range("C1:C1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle Y").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1Nopert.xlsx").Activate
    Windows("Patient1Nopert.xlsx").Activate
    Range("C1:C1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Ankle Z").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1Nopert.xlsx").Activate
    Range("N1:N1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee X").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1Nopert.xlsx").Activate
    Range("O1:O1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee Y").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1Nopert.xlsx").Activate
    Range("P1:P1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Knee Z").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        Windows("Patient1Nopert.xlsx").Activate
    Range("I1:I1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip X").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1Nopert.xlsx").Activate
    Range("J1:J1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip Y").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1Nopert.xlsx").Activate
    Range("J1:J1505").Select
    Selection.Copy
    Windows("master.xlsx").Activate
    Sheets("Hip Z").Select
    Range("C3016").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Patient1Nopert.xlsx").Activate
    ActiveWindow.Close

1 个答案:

答案 0 :(得分：0)

这是一种可行的方法：

Sub Tester()

    Const SRC_FLDR As String = "C:\something\myfiles\"

    Dim wbM As Workbook, wbS As Workbook, shtS As Worksheet
    Dim i As Long, colOff As Long

    Set wbM = Workbooks("master.xlsx")

    colOff = 0 'paste position offset

    For i = 1 To 10 'eg
        Set wbS = Workbooks.Open(SRC_FLDR & "Patient" & i & "GlobalP.xlsm")
        Set shtS = wbS.Sheets(1)

        'copy ranges to specific positions on Master sheets
        '  offset changes each time through the loop
        'NOTE: no need to use Activate/Select here
        shtS.Range("B1:B1505").Copy wbS.Sheets("Ankle X").Range("C2").Offset(0, colOff)
        shtS.Range("C1:C1505").Copy wbS.Sheets("Ankle Y").Range("C2").Offset(0, colOff)
        shtS.Range("C1:C1505").Copy wbS.Sheets("Ankle Z").Range("C2").Offset(0, colOff)
        'etc...
        'etc...

        wbS.Close savechanges:=False
        colOff = colOff + 1

    Next i

End Sub
相关问题
最新问题