简体   繁体   English

VBA 将多个工作簿中的一个单元格复制到另一个工作表中的特定单元格中

[英]VBA to copy a cell from multiple workbooks into specific cells in the another sheet

i have around 500 workbooks each one contains 5 sheets i want to extract data from specific cells in sheet 1 and 2 and 3 (lest say sheet 1 needs cells B2,B6,B8. and sheet 2 cells B2,C2,D2 and sheet 3 B6,D6) then past them into one sheet in specific order (lest say from sheet one goes to A,B,C columns respectively and from sheet 2 follows in columns D,E,F, then from sheet 3 also follows columns G,H,I. In short i want to make a table from the extracted cells我有大约 500 个工作簿,每个工作簿包含 5 个工作表我想从工作表 1、2 和 3 中的特定单元格中提取数据(以免工作表 1 需要单元格 B2、B6、B8。以及工作表 2 单元格 B2、C2、D2 和工作表 3 B6,D6)然后按特定顺序将它们放入一张纸中(以免从第一张到 A、B、C 列,从第 2 列到 D、E、F 列,然后从第 3 列到 G 列, H,I. 简而言之,我想从提取的单元格中制作一个表格

thanks in advance提前致谢

this is what i ended up with after recording这是我录制后的结果

Sub Extract_Data() ' ' Extract_Data Macro ' Sub Extract_Data() ' ' Extract_Data 宏 '

enter 
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B2").Select
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("B2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("C2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("D2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("E2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("F2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("G2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Sheets("RF").Select
ActiveWindow.SmallScroll Down:=-54
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("H2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("I2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("I2").Select
ActiveSheet.Paste
Range("J2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("K2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("L2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("M2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("N2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("O2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("P2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("B21").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("Q2").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("R2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("S2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B24").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("T2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B25").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("U2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("V2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=-18
Range("C4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("W2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("X2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("Y2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("Z2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AA2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AB2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AC2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AD2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AE2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AF2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("C21").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AG2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AH2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AI2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C24").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AJ2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C25").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AK2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AL2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=-57
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AM2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AN2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AO2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AP2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AQ2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AR2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AS2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AT2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AU2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=9
Range("D14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AV2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AW2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D21").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AX2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("D23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AY2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D24").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("AZ2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D25").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BA2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("D26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BB2").Select
ActiveSheet.Paste
Range("BC2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Sheets("TI&PW").Select
ActiveWindow.SmallScroll Down:=-27
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("BD2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BE2").Select
ActiveSheet.Paste
Range("BF2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BG2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BH2").Select
ActiveSheet.Paste
Range("BI2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=12
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BJ2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BK2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C19").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BL2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F19").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BM2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BN2").Select
ActiveSheet.Paste
Range("BO2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Range("BP2").Select
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C21").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F21").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BQ2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("C27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BR2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BS2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BT2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BU2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C29").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BV2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F29").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BW2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C30").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BX2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F30").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BY2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C31").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("BZ2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F31").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("CA2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("C32").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("CB2").Select
ActiveSheet.Paste
Windows("Scopes_13753_PO11 WL MW TSSR_GeneratedDraft_20220807171314.xlsx"). _
    Activate
Range("F32").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Survey Data Base.xlsx").Activate
Range("CC2").Select
ActiveSheet.Paste

End Sub code here在这里结束子代码

@Cyrus this is the list of actions needed @Cyrus 这是所需操作的列表

nb: all needed sheets in all workbooks have the same names and order注意:所有工作簿中所有需要的工作表都具有相同的名称和顺序

enterSheets("Basic Information").Select
Range("B2").Select
Selection.Copy
ActiveSheet.Paste
Range("B2").Select
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("C2").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("D2").Select
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("E2").Select
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("F2").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("G2").Select
Sheets("RF").Select
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("H2").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("I2").Select
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Range("I2").Select
ActiveSheet.Paste
Range("J2").Select
Range("B8").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("K2").Select
Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("B10").Select
Application.CutCopyMode = False
Selection.Copy
Range("L2").Select
ActiveSheet.Paste
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Range("M2").Select
ActiveSheet.Paste
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Range("N2").Select
ActiveSheet.Paste
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Range("O2").Select
ActiveSheet.Paste
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Range("P2").Select
ActiveSheet.Paste
Range("B21").Select
Application.CutCopyMode = False
Selection.Copy
Range("Q2").Select
ActiveSheet.Paste
Range("B22").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
ActiveSheet.Paste
Range("B23").Select
Application.CutCopyMode = False
Selection.Copy
Range("S2").Select
ActiveSheet.Paste
Range("B24").Select
Application.CutCopyMode = False
Selection.Copy
Range("T2").Select
ActiveSheet.Paste
Range("B25").Select
Application.CutCopyMode = False
Selection.Copy
Range("U2").Select
ActiveSheet.Paste
Range("B26").Select
Application.CutCopyMode = False
Selection.Copy
Range("V2").Select
ActiveSheet.Paste
Range("C4").Select
Application.CutCopyMode = False
Selection.Copy
Range("W2").Select
ActiveSheet.Paste
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Range("X2").Select
ActiveSheet.Paste
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Range("Y2").Select
ActiveSheet.Paste
Range("C8").Select
Application.CutCopyMode = False
Selection.Copy
Range("Z2").Select
ActiveSheet.Paste
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
Range("AA2").Select
ActiveSheet.Paste
Range("C10").Select
Application.CutCopyMode = False
Selection.Copy
Range("AB2").Select
ActiveSheet.Paste
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
Range("AC2").Select
ActiveSheet.Paste
Range("C12").Select
Application.CutCopyMode = False
Selection.Copy
Range("AD2").Select
ActiveSheet.Paste
Range("C13").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE2").Select
ActiveSheet.Paste
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
Range("AF2").Select
ActiveSheet.Paste
Range("C21").Select
Application.CutCopyMode = False
Selection.Copy
Range("AG2").Select
ActiveSheet.Paste
Range("C22").Select
Application.CutCopyMode = False
Selection.Copy
Range("AH2").Select
ActiveSheet.Paste
Range("C23").Select
Application.CutCopyMode = False
Selection.Copy
Range("AI2").Select
ActiveSheet.Paste
Range("C24").Select
Application.CutCopyMode = False
Selection.Copy
Range("AJ2").Select
ActiveSheet.Paste
Range("C25").Select
Application.CutCopyMode = False
Selection.Copy
Range("AK2").Select
ActiveSheet.Paste
Range("C26").Select
Application.CutCopyMode = False
Selection.Copy
Range("AL2").Select
ActiveSheet.Paste
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Range("AM2").Select
ActiveSheet.Paste
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
Range("AN2").Select
ActiveSheet.Paste
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Range("AO2").Select
ActiveSheet.Paste
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Range("AP2").Select
ActiveSheet.Paste
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
Range("AQ2").Select
ActiveSheet.Paste
Range("D10").Select
Application.CutCopyMode = False
Selection.Copy
Range("AR2").Select
ActiveSheet.Paste
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Range("AS2").Select
ActiveSheet.Paste
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
Range("AT2").Select
ActiveSheet.Paste
Range("D13").Select
Application.CutCopyMode = False
Selection.Copy
Range("AU2").Select
ActiveSheet.Paste
Range("D14").Select
Application.CutCopyMode = False
Selection.Copy
Range("AV2").Select
ActiveSheet.Paste
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
Range("AW2").Select
Range("D21").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("D22").Select
Application.CutCopyMode = False
Selection.Copy
Range("AX2").Select
ActiveSheet.Paste
Range("D23").Select
Application.CutCopyMode = False
Selection.Copy
Range("AY2").Select
ActiveSheet.Paste
Range("D24").Select
Application.CutCopyMode = False
Selection.Copy
Range("AZ2").Select
ActiveSheet.Paste
Range("D25").Select
Application.CutCopyMode = False
Selection.Copy
Range("BA2").Select
ActiveSheet.Paste
Range("D26").Select
Application.CutCopyMode = False
Selection.Copy
Range("BB2").Select
ActiveSheet.Paste
Range("BC2").Select
Sheets("TI&PW").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("BD2").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Range("BE2").Select
ActiveSheet.Paste
Range("BF2").Select
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("F11").Select
Application.CutCopyMode = False
Selection.Copy
Range("BG2").Select
ActiveSheet.Paste
Range("C12").Select
Application.CutCopyMode = False
Selection.Copy
Range("BH2").Select
ActiveSheet.Paste
Range("BI2").Select
Range("F12").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Range("BJ2").Select
ActiveSheet.Paste
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
Range("BK2").Select
ActiveSheet.Paste
Range("C19").Select
Application.CutCopyMode = False
Selection.Copy
Range("BL2").Select
ActiveSheet.Paste
Range("F19").Select
Application.CutCopyMode = False
Selection.Copy
Range("BM2").Select
ActiveSheet.Paste
Range("C20").Select
Application.CutCopyMode = False
Selection.Copy
Range("BN2").Select
ActiveSheet.Paste
Range("BO2").Select
Range("F20").Select
Application.CutCopyMode = False
Selection.Copy`enter code here`
ActiveSheet.Paste
Range("BP2").Select
Range("C21").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("F21").Select
Application.CutCopyMode = False
Selection.Copy
Range("BQ2").Select
ActiveSheet.Paste
Range("C27").Select
Application.CutCopyMode = False
Selection.Copy
Range("BR2").Select
ActiveSheet.Paste
Range("F27").Select
Application.CutCopyMode = False
Selection.Copy
Range("BS2").Select
ActiveSheet.Paste
Range("C28").Select
Application.CutCopyMode = False
Selection.Copy
Range("BT2").Select
ActiveSheet.Paste
Range("F28").Select
Application.CutCopyMode = False
Selection.Copy
Range("BU2").Select
ActiveSheet.Paste
Range("C29").Select
Application.CutCopyMode = False
Selection.Copy
Range("BV2").Select
ActiveSheet.Paste
Range("F29").Select
Application.CutCopyMode = False
Selection.Copy
Range("BW2").Select
ActiveSheet.Paste
Range("C30").Select
Application.CutCopyMode = False
Selection.Copy
Range("BX2").Select
ActiveSheet.Paste
Range("F30").Select
Application.CutCopyMode = False
Selection.Copy
Range("BY2").Select
ActiveSheet.Paste
Range("C31").Select
Application.CutCopyMode = False
Selection.Copy
Range("BZ2").Select
ActiveSheet.Paste
Range("F31").Select
Application.CutCopyMode = False
Selection.Copy
Range("CA2").Select
ActiveSheet.Paste
Range("C32").Select
Application.CutCopyMode = False
Selection.Copy
Range("CB2").Select
ActiveSheet.Paste
Range("F32").Select
Application.CutCopyMode = False
Selection.Copy
Range("CC2").Select
ActiveSheet.Paste code here

This is not a complete solution to your question.这不是您问题的完整解决方案。 The code contains the recorded code, which has not yet been completely edited.代码包含录制的代码,尚未完全编辑。 I'm leaving that to you to complete.我把它留给你完成。 There are instructions in the comments in the code below.下面代码的注释中有说明。 I'm autistic;我是自闭症; so I can sometimes appear to school others, when I'm only trying to help.所以我有时会出现在学校的其他人面前,而我只是想提供帮助。

The recorded code seems to have omitted a few of the source ranges like "B2" which will need to be manually corrected记录的代码似乎省略了一些源范围,如“B2”,需要手动更正

The part of the code, which identifies the files in the folder was taken from here.识别文件夹中文件的代码部分取自此处。

Option Explicit

Private Sub Test15()

Dim iRow&
Dim FileName$, sPath$
Dim wb As Workbook, wbSurvey As Workbook
Dim wsSurvey As Worksheet, WS As Worksheet

sPath = "C:\Users\user\Documents\HP Laptop\Documents\Documents\Jobs\DIT\IDMB\Stack Overflow\okinawa"

Set wbSurvey = ThisWorkbook
Set wsSurvey = wbSurvey.Sheets("Survey")

'FileName = Dir(strFolder & "\*123.xls")
FileName = Dir(sPath)
iRow = 2
Do While Len(FileName) > 0
    Set wb = Workbooks.Open(FileName)
    
    'change the phrase FIRST TAB here to the name of the first sheet, which is used in your process.
    Set WS = wb.Sheets("FIRST TAB")
    
    'this is how the edited code below needs to look. cutcopymode and scroll down lines of code can be deleted
    WS.Range("B2").Copy
    wsSurvey.Range("B" & iRow).PasteSpecial (xlPasteValues)
    
    'this is an example of which lines of code need to be edited to look like the above two lines of code.
    WS. _
        Activate
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("C" & iRow).PasteSpecial (xlPasteValues)
    
    WS. _
        Activate
    Range("B6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("D" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("E" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F5").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("F" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D5").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("G" & iRow).PasteSpecial (xlPasteValues)
    
    Set WS = wb.Sheets("RF")
    
    WS. _
        Activate
    Range("B4").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("H" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("I" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("I2").Select
    .PasteSpecial (xlPasteValues)
    Range("J" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("K" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=6
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("L" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("M" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("N" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("O" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B14").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("P" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=6
    Range("B21").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("Q" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    ActiveWindow.SmallScroll ToRight:=4
    WS. _
        Activate
    Range("B22").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("R" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B23").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("S" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B24").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("T" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B25").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("U" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B26").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("V" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=-18
    Range("C4").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("W" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("X" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("Y" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C8").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("Z" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C9").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AA" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C10").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AB" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C11").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AC" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C12").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AD" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AE" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=6
    Range("C14").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AF" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=6
    Range("C21").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AG" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C22").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AH" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C23").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AI" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C24").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AJ" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C25").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AK" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C26").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AL" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=-57
    Range("D4").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AM" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AN" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D7").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AO" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D8").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AP" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D9").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AQ" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D10").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AR" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D11").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AS" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D12").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AT" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D13").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AU" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=9
    Range("D14").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AV" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D15").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AW" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D21").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D22").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AX" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=6
    Range("D23").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AY" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D24").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("AZ" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D25").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BA" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("D26").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BB" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    
    Set WS = wb.Sheets("TI&PW")
    
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=-27
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("BD" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F2").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("B3").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BE" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    Range("BF" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C11").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F11").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BG" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C12").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BH" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F12").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=12
    Range("C18").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BJ" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F18").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BK" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C19").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BL" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F19").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BM" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C20").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BN" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F20").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    Range("BP" & iRow).PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C21").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F21").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BQ" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    ActiveWindow.SmallScroll Down:=6
    Range("C27").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BR" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F27").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BS" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C28").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BT" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F28").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BU" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C29").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BV" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F29").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BW" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C30").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BX" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F30").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BY" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C31").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("BZ" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F31").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("CA" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("C32").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("CB" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)
    WS. _
        Activate
    Range("F32").Select
    Application.CutCopyMode = False
    Selection.Copy
    wsSurvey
    Range("CC" & iRow).PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteValues)

    wb.Close (False)
    FileName = Dir
    iRow = iRow + 1
Loop

End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

相关问题 VBA 将一个单元格从多个工作簿复制到另一个工作表中 - VBA to copy a cell from multiple workbooks into another sheet VBA从另一个单元格中的工作表复制特定单元格 - VBA Copy a specific Cell from a sheet in an another cell vba循环,以便将特定单元格从一张纸复制到另一张纸 - vba loop in order to copy specific cells from one sheet to another VBA-根据多个条件从另一张纸复制单元格 - VBA - copy cells from another sheet based on multiple criteria VBA:将多个工作簿(具有多个工作表)中的特定单元格复制到单个工作簿 - VBA : Copy Specific cells from Multiple Workbooks(having Multiple Worksheets) to a single WorkBook VBA 将数据从多个工作簿复制到主表中 - VBA to copy data from multiple workbooks into master sheet VBA从工作表“ A”复制单元格到工作表“ B”中的合并单元格 - VBA to copy cell from Sheet“A” to merged cells in Sheet“B” 如何在一张纸到另一张纸中的特定单元格的范围内复制单元格数据? - How do you copy cell data in a range from one sheet to specific cells in another sheet? 如果单元格值大于0,excel vba将单元格复制到另一个工作表 - excel vba copy cells to another sheet if cell value is greater than 0 如何将多个工作簿中的特定单元格内容映射到单个工作表中 - How to map specific cell contents from multiple workbooks into a single sheet
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM