VBA：将特定单元格从 Folderpicker 识别的文件复制并粘贴到 Filepicker 识别的目标文件

Question

我的问题：我想从多个工作簿（称为：商业案例 (1) 和上升）中复制特定单元格，并且在这些工作簿中，我想从 2 个不同的工作表中复制数据（命名为“摘要”和“业务案例输入表”）。 我不知道如何编写代码来正确复制和粘贴数据？

我想复制的地方：

文件名：“商业案例 (x)”

工作表：“摘要”

细胞：

D4  D5  D6  D7  D8  K4  K5  K6  K7  K8  E12 F12 E14 E16 E17 E18 E19 E21 E22 E23 E26 E27 E28 E29 G29 E31 E32 E33 E34 E35 E36 E39 E40 E38

并且来自同一个工作簿（业务案例 (X)），但我想获得以下另一张工作表。

工作表：“业务案例输入工作表”

细胞：

G6  H6  I6  J6  K6  L6  M6  N6  O6  P6  Q6  G34 H34 I34 J34 K34 L34 M34 N34 O34 P34 Q34 G8  H8  I8  J8  K8  L8  M8  N8  O8  P8  Q8  G36 H36 I36 J36 K36 L36 M36 N36 O36 P36 Q36 G35 H35 I35 J35 K35 L35 M35 N35 O35 P35 Q35 G43 H43 I43 J43 K43 L43 M43 N43O43 P43 Q43 G45 H45 I45 J45 K45 L45 M45 N45 O45 P45 Q45 G46 H46 I46 J46 K46 L46 M46 N46 O46 P46 Q46 G47 H47 I47 J47 K47 L47 M47 N47 O47 P47 Q47 G48 H48 I48 J48 K48 L48 M48 N48 O48 P48 Q48 G61 H61 I61 J61 K61 L61 M61 N61 O61 P61 Q61 G62 H62 I62 J62 K62 L62 M62 N62 O62 P62 Q62 G63 H63 I63 J63 K63 L63 M63 N63 O63 P63 Q63 G66 H66 I66 J66 K66 L66 M66 N66 O66 P66 Q66 G68 H68 I68 J68 K68 L68 M68 N68 O68 P68 Q68 G69 H69 I69 J69 K69 L69 M69 N69 O69 P69 Q69 

接收文件名为：“Portfolio Overview”

工作表：" 数据输入 商业案例 1 的单元格： H41:HK41

商业案例 1 的单元格： H42:HK42

商业案例 1 的单元格： H43:HK43

例子

E.g. Data from Qorkbook: Business case 1
Sheet: Summary
Cell: D4 

Copy to

Workbook: Portfolio Tool
Sheet: Datainput
Cell:41

D5 to I41 
D6 to J41 
D7 to K41 
D8 to L41 
K4 to M41 
K5 to N41 
Etc.

.... 以此类推，目标文件中的一行，用于从其中检索数据的每个业务案例。

如前所述；我不知道如何编写跨越多个工作簿和 2 张工作表的复制/粘贴代码，以将数据检索到目标文件。

我当前的代码如下：

Option Explicit 'Spell checker

'The "folder picker" macro

Function ChooseFolder(strTitle As String, fDtype) As String
    Dim fldr As FileDialog
    Dim sItem As String

    Set fldr = Application.FileDialog(fDtype)
    With fldr
        .Title = strTitle
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
    
End Function

Sub datatransfer_Summary()

'Cancel diasbled, as we dont want half-data etc.

Application.EnableCancelKey = xlDisabled

'Speed optimization

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
 'Copy and paste - Thanks to FaneDuru from StackOverflow

    Dim FolderPath As String, FilePath As String, Filename As String, iRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, shTF As Worksheet
    
    FolderPath = ChooseFolder("Please select the Folder path", msoFileDialogFolderPicker)
    
    FilePath = FolderPath & "\Business Case (*.xls*"

    Set wb2 = ThisWorkbook
    Set shTF = wb2.Worksheets("Datainput")

    Filename = Dir(FilePath)
    iRow = 41 'starting row to be filled
    
    Do While Filename <> ""
        Set wb1 = Workbooks.Open(FolderPath & "\" & Filename)

        With wb1.Worksheets(1)
            shTF.Range("D" & iRow) = wb1.Name
            shTF.Range(shTF.Cells(iRow, "H"), shTF.Cells(iRow, "L")).Value = Application.Transpose(.Range("D4:D8").Value)
            shTF.Range(shTF.Cells(iRow, "M"), shTF.Cells(iRow, "Q")).Value = Application.Transpose(.Range("K4:K8").Value)
            shTF.Range(shTF.Cells(iRow, "R"), shTF.Cells(iRow, "S")).Value = .Range("E12:F12").Value
            shTF.Range("T" & iRow).Value = .Range("E14").Value
            shTF.Range(shTF.Cells(iRow, "U"), shTF.Cells(iRow, "X")).Value = Application.Transpose(.Range("E16:E19").Value)
            shTF.Range(shTF.Cells(iRow, "Y"), shTF.Cells(iRow, "AA")).Value = Application.Transpose(.Range("E21:E23").Value)
            shTF.Range(shTF.Cells(iRow, "AB"), shTF.Cells(iRow, "AE")).Value = Application.Transpose(.Range("E26:E29").Value)
            shTF.Range("AF" & iRow).Value = .Range("G29").Value
            shTF.Range(shTF.Cells(iRow, "AG"), shTF.Cells(iRow, "AL")).Value = Application.Transpose(.Range("E31:E36").Value)
            shTF.Range(shTF.Cells(iRow, "AM"), shTF.Cells(iRow, "AN")).Value = Application.Transpose(.Range("E39:E40").Value)
            shTF.Range("AO" & iRow).Value = .Range("E38").Value
            iRow = iRow + 1
        End With
        
        wb1.Close False

        Filename = Dir
    Loop
    'wb2.Close True 'un comment if you want the target workbook to be closed

       
   


  MsgBox "Finished gathering data"

End Sub

Sub datatransfer_Input_sheet()

'Cancel diasbled, as we dont want half-data etc.

Application.EnableCancelKey = xlDisabled

'Speed optimization

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
 'Copy and paste - Thanks to FaneDuru from StackOverflow

    Dim FolderPath As String, FilePath As String, Filename As String, iRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, shTF As Worksheet
    
    FolderPath = ChooseFolder("Please select the Folder path", msoFileDialogFolderPicker)
    
    FilePath = FolderPath & "\Business Case (*.xls*"

    Set wb2 = ThisWorkbook
    Set shTF = wb2.Worksheets("Datainput")

    Filename = Dir(FilePath)
    iRow = 41 'starting row to be filled
    
    Do While Filename <> ""
        Set wb1 = Workbooks.Open(FolderPath & "\" & Filename)

        With wb1.Worksheets("Business Case Input sheet")
            shTF.Range("AP" & iRow).Value = .Range("G6").Value
            shTF.Range("AQ" & iRow).Value = .Range("H6").Value
            shTF.Range("AR" & iRow).Value = .Range("I6").Value
            shTF.Range("AS" & iRow).Value = .Range("J6").Value
            shTF.Range("AT" & iRow).Value = .Range("K6").Value
            shTF.Range("AU" & iRow).Value = .Range("L6").Value
            shTF.Range("AV" & iRow).Value = .Range("M6").Value
            shTF.Range("AW" & iRow).Value = .Range("N6").Value
            shTF.Range("AX" & iRow).Value = .Range("O6").Value
            shTF.Range("AY" & iRow).Value = .Range("P6").Value
            shTF.Range("AZ" & iRow).Value = .Range("Q6").Value
            shTF.Range("AZ" & iRow).Value = .Range("Q6").Value
            shTF.Range("BA" & iRow).Value = .Range("G34").Value
            shTF.Range("BB" & iRow).Value = .Range("H34").Value
            shTF.Range("BC" & iRow).Value = .Range("I34").Value
            shTF.Range("BD" & iRow).Value = .Range("J34").Value
            shTF.Range("BE" & iRow).Value = .Range("K34").Value
            shTF.Range("BF" & iRow).Value = .Range("L34").Value
            shTF.Range("BG" & iRow).Value = .Range("M34").Value
            shTF.Range("BH" & iRow).Value = .Range("N34").Value
            shTF.Range("BI" & iRow).Value = .Range("O34").Value
            shTF.Range("BJ" & iRow).Value = .Range("P34").Value
            shTF.Range("BK" & iRow).Value = .Range("Q34").Value
            shTF.Range("BL" & iRow).Value = .Range("G8").Value
            shTF.Range("BM" & iRow).Value = .Range("H8").Value
            shTF.Range("BN" & iRow).Value = .Range("I8").Value
            shTF.Range("BO" & iRow).Value = .Range("J8").Value
            shTF.Range("BP" & iRow).Value = .Range("K8").Value
            shTF.Range("BQ" & iRow).Value = .Range("L8").Value
            shTF.Range("BR" & iRow).Value = .Range("M8").Value
            shTF.Range("BS" & iRow).Value = .Range("N8").Value
            shTF.Range("BT" & iRow).Value = .Range("O8").Value
            shTF.Range("BU" & iRow).Value = .Range("P8").Value
            shTF.Range("BV" & iRow).Value = .Range("Q8").Value
            shTF.Range("BW" & iRow).Value = .Range("G36").Value
            shTF.Range("BX" & iRow).Value = .Range("H36").Value
            shTF.Range("BY" & iRow).Value = .Range("I36").Value
            shTF.Range("BZ" & iRow).Value = .Range("J36").Value
            shTF.Range("CA" & iRow).Value = .Range("K36").Value
            shTF.Range("CB" & iRow).Value = .Range("L36").Value
            shTF.Range("CC" & iRow).Value = .Range("M36").Value
            shTF.Range("CD" & iRow).Value = .Range("N36").Value
            shTF.Range("CE" & iRow).Value = .Range("O36").Value
            shTF.Range("CF" & iRow).Value = .Range("P36").Value
            shTF.Range("CG" & iRow).Value = .Range("Q36").Value
            shTF.Range("CH" & iRow).Value = .Range("G35").Value
            shTF.Range("CI" & iRow).Value = .Range("H35").Value
            shTF.Range("CJ" & iRow).Value = .Range("I35").Value
            shTF.Range("CK" & iRow).Value = .Range("J35").Value
            shTF.Range("CL" & iRow).Value = .Range("K35").Value
            shTF.Range("CM" & iRow).Value = .Range("L35").Value
            shTF.Range("CN" & iRow).Value = .Range("M35").Value
            shTF.Range("CO" & iRow).Value = .Range("N35").Value
            shTF.Range("CP" & iRow).Value = .Range("O35").Value
            shTF.Range("CQ" & iRow).Value = .Range("P35").Value
            shTF.Range("CR" & iRow).Value = .Range("Q35").Value
            shTF.Range("CS" & iRow).Value = .Range("G43").Value
            shTF.Range("CT" & iRow).Value = .Range("H43").Value
            shTF.Range("CU" & iRow).Value = .Range("I43").Value
            shTF.Range("CV" & iRow).Value = .Range("J43").Value
            shTF.Range("CW" & iRow).Value = .Range("K43").Value
            shTF.Range("CX" & iRow).Value = .Range("L43").Value
            shTF.Range("CY" & iRow).Value = .Range("M43").Value
            shTF.Range("CZ" & iRow).Value = .Range("N43").Value
            shTF.Range("DA" & iRow).Value = .Range("O43").Value
            shTF.Range("DB" & iRow).Value = .Range("P43").Value
            shTF.Range("DC" & iRow).Value = .Range("Q43").Value
            shTF.Range("DD" & iRow).Value = .Range("G45").Value
            shTF.Range("DE" & iRow).Value = .Range("H45").Value
            shTF.Range("DF" & iRow).Value = .Range("I45").Value
            shTF.Range("DG" & iRow).Value = .Range("J45").Value
            shTF.Range("DH" & iRow).Value = .Range("K45").Value
            shTF.Range("DI" & iRow).Value = .Range("L45").Value
            shTF.Range("DJ" & iRow).Value = .Range("M45").Value
            shTF.Range("DK" & iRow).Value = .Range("N45").Value
            shTF.Range("DL" & iRow).Value = .Range("O45").Value
            shTF.Range("DM" & iRow).Value = .Range("P45").Value
            shTF.Range("DN" & iRow).Value = .Range("Q45").Value
            shTF.Range("DO" & iRow).Value = .Range("G46").Value
            shTF.Range("DP" & iRow).Value = .Range("H46").Value
            shTF.Range("DQ" & iRow).Value = .Range("I46").Value
            shTF.Range("DR" & iRow).Value = .Range("J46").Value
            shTF.Range("DS" & iRow).Value = .Range("K46").Value
            shTF.Range("DT" & iRow).Value = .Range("L46").Value
            shTF.Range("DU" & iRow).Value = .Range("M46").Value
            shTF.Range("DB" & iRow).Value = .Range("N46").Value
            shTF.Range("DW" & iRow).Value = .Range("O46").Value
            shTF.Range("DX" & iRow).Value = .Range("P46").Value
            shTF.Range("DY" & iRow).Value = .Range("Q46").Value
            shTF.Range("DZ" & iRow).Value = .Range("G47").Value
            shTF.Range("EA" & iRow).Value = .Range("H47").Value
            shTF.Range("EB" & iRow).Value = .Range("I47").Value
            shTF.Range("EC" & iRow).Value = .Range("J47").Value
            shTF.Range("ED" & iRow).Value = .Range("K47").Value
            shTF.Range("EE" & iRow).Value = .Range("L47").Value
            shTF.Range("EF" & iRow).Value = .Range("M47").Value
            shTF.Range("EG" & iRow).Value = .Range("N47").Value
            shTF.Range("EH" & iRow).Value = .Range("O47").Value
            shTF.Range("EI" & iRow).Value = .Range("P47").Value
            shTF.Range("EJ" & iRow).Value = .Range("Q47").Value
            shTF.Range("EK" & iRow).Value = .Range("G48").Value
            shTF.Range("EL" & iRow).Value = .Range("H48").Value
            shTF.Range("EM" & iRow).Value = .Range("I48").Value
            shTF.Range("EN" & iRow).Value = .Range("J48").Value
            shTF.Range("EO" & iRow).Value = .Range("K48").Value
            shTF.Range("EP" & iRow).Value = .Range("L48").Value
            shTF.Range("EQ" & iRow).Value = .Range("M48").Value
            shTF.Range("ER" & iRow).Value = .Range("N48").Value
            shTF.Range("ES" & iRow).Value = .Range("O48").Value
            shTF.Range("ET" & iRow).Value = .Range("P48").Value
            shTF.Range("EU" & iRow).Value = .Range("Q48").Value
            shTF.Range("EV" & iRow).Value = .Range("G61").Value
            shTF.Range("EW" & iRow).Value = .Range("H61").Value
            shTF.Range("EX" & iRow).Value = .Range("H61").Value
            shTF.Range("EY" & iRow).Value = .Range("J61").Value
            shTF.Range("EZ" & iRow).Value = .Range("K61").Value
            shTF.Range("FA" & iRow).Value = .Range("L61").Value
            shTF.Range("FB" & iRow).Value = .Range("M61").Value
            shTF.Range("FC" & iRow).Value = .Range("N61").Value
            shTF.Range("FD" & iRow).Value = .Range("O61").Value
            shTF.Range("FE" & iRow).Value = .Range("P61").Value
            shTF.Range("FF" & iRow).Value = .Range("Q61").Value
            shTF.Range("FG" & iRow).Value = .Range("G62").Value
            shTF.Range("FH" & iRow).Value = .Range("H62").Value
            shTF.Range("FI" & iRow).Value = .Range("I62").Value
            shTF.Range("FJ" & iRow).Value = .Range("J62").Value
            shTF.Range("FK" & iRow).Value = .Range("K62").Value
            shTF.Range("FL" & iRow).Value = .Range("L62").Value
            shTF.Range("FM" & iRow).Value = .Range("M62").Value
            shTF.Range("FN" & iRow).Value = .Range("N62").Value
            shTF.Range("FO" & iRow).Value = .Range("O62").Value
            shTF.Range("FP" & iRow).Value = .Range("P62").Value
            shTF.Range("FQ" & iRow).Value = .Range("Q62").Value
            shTF.Range("FR" & iRow).Value = .Range("G63").Value
            shTF.Range("FS" & iRow).Value = .Range("H63").Value
            shTF.Range("FT" & iRow).Value = .Range("I63").Value
            shTF.Range("FU" & iRow).Value = .Range("J63").Value
            shTF.Range("FV" & iRow).Value = .Range("K63").Value
            shTF.Range("FW" & iRow).Value = .Range("L63").Value
            shTF.Range("FX" & iRow).Value = .Range("M63").Value
            shTF.Range("FY" & iRow).Value = .Range("N63").Value
            shTF.Range("FZ" & iRow).Value = .Range("O63").Value
            shTF.Range("GA" & iRow).Value = .Range("P63").Value
            shTF.Range("GB" & iRow).Value = .Range("Q63").Value
            shTF.Range("GC" & iRow).Value = .Range("G66").Value
            shTF.Range("GD" & iRow).Value = .Range("H66").Value
            shTF.Range("GE" & iRow).Value = .Range("I66").Value
            shTF.Range("GF" & iRow).Value = .Range("J66").Value
            shTF.Range("GG" & iRow).Value = .Range("K66").Value
            shTF.Range("GH" & iRow).Value = .Range("L66").Value
            shTF.Range("GI" & iRow).Value = .Range("M66").Value
            shTF.Range("GJ" & iRow).Value = .Range("N66").Value
            shTF.Range("GK" & iRow).Value = .Range("O66").Value
            shTF.Range("GL" & iRow).Value = .Range("P66").Value
            shTF.Range("GM" & iRow).Value = .Range("Q66").Value
            shTF.Range("GN" & iRow).Value = .Range("G68").Value
            shTF.Range("GO" & iRow).Value = .Range("H68").Value
            shTF.Range("GP" & iRow).Value = .Range("I68").Value
            shTF.Range("GQ" & iRow).Value = .Range("J68").Value
            shTF.Range("GR" & iRow).Value = .Range("K68").Value
            shTF.Range("GS" & iRow).Value = .Range("L68").Value
            shTF.Range("GT" & iRow).Value = .Range("M68").Value
            shTF.Range("GU" & iRow).Value = .Range("N68").Value
            shTF.Range("GV" & iRow).Value = .Range("O68").Value
            shTF.Range("GW" & iRow).Value = .Range("P68").Value
            shTF.Range("GX" & iRow).Value = .Range("Q68").Value
            shTF.Range("GY" & iRow).Value = .Range("G69").Value
            shTF.Range("GZ" & iRow).Value = .Range("H69").Value
            shTF.Range("HA" & iRow).Value = .Range("I69").Value
            shTF.Range("HB" & iRow).Value = .Range("J69").Value
            shTF.Range("HC" & iRow).Value = .Range("K69").Value
            shTF.Range("HD" & iRow).Value = .Range("L69").Value
            shTF.Range("HE" & iRow).Value = .Range("M69").Value
            shTF.Range("HF" & iRow).Value = .Range("N69").Value
            shTF.Range("HG" & iRow).Value = .Range("O69").Value
            shTF.Range("HH" & iRow).Value = .Range("P69").Value
            shTF.Range("HI" & iRow).Value = .Range("Q69").Value
                     
                        
            iRow = iRow + 1
        End With

        wb1.Close False

        Filename = Dir
    Loop
    'wb2.Close True 'un comment if you want the target workbook to be closed
   

MsgBox "Finished gathering data"

End Sub

最好的 迈克尔

Answer 1

请尝试下一个代码。它只会填充第一部分（直到包括 AO）。这样做是为了向您展示要遵循的方式。该代码假定目标工作簿是保留 VBA 代码的工作簿。我只想相信我正确地理解了你真正想要的东西：

Sub datatransfer()
    Dim FolderPath As String, FilePath As String, Filename As String, iRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, shTF As Worksheet
    
    FolderPath = ChooseFolder("Please select the Folder path", msoFileDialogFolderPicker)
    
    FilePath = FolderPath & "\Business Case (*.xls*" 

    Set wb2 = ThisWorkbook
    Set shTF = wb2.Worksheets("Datainput")

    Filename = Dir(FilePath)
    iRow = 41 'starting row to be filled
    
    Do While Filename <> ""
        Set wb1 = Workbooks.Open(FolderPath & "\" & Filename)

        With wb1.Worksheets(1)
            shTF.Range("D" & iRow) = wb1.Name
            shTF.Range(shTF.Cells(iRow, "H"), shTF.Cells(iRow, "L")).Value = Application.Transpose(.Range("D4:D8").Value)
            shTF.Range(shTF.Cells(iRow, "M"), shTF.Cells(iRow, "Q")).Value = Application.Transpose(.Range("K4:K8").Value)
            shTF.Range(shTF.Cells(iRow, "R"), shTF.Cells(iRow, "S")).Value = .Range("E12:F12").Value
            shTF.Range("T" & iRow).Value = .Range("E14").Value
            shTF.Range(shTF.Cells(iRow, "U"), shTF.Cells(iRow, "X")).Value = Application.Transpose(.Range("E16:E19").Value)
            shTF.Range(shTF.Cells(iRow, "Y"), shTF.Cells(iRow, "AC")).Value = Application.Transpose(.Range("E21:E27").Value)
            shTF.Range("AD" & iRow).Value = .Range("E27").Value
            shTF.Range("AE" & iRow).Value = .Range("E29").Value
            shTF.Range("AF" & iRow).Value = .Range("G29").Value
            shTF.Range(shTF.Cells(iRow, "AG"), shTF.Cells(iRow, "AL")).Value = Application.Transpose(.Range("E32:E36").Value)
            shTF.Range(shTF.Cells(iRow, "AM"), shTF.Cells(iRow, "AN")).Value = Application.Transpose(.Range("E39:E40").Value)
            shTF.Range("AO" & iRow).Value = .Range("E38").Value
            iRow = iRow + 1
        End With

        wb1.Close False

        Filename = Dir
    Loop
    'wb2.Close True 'un comment if you want the target workbook to be closed
End Sub

请使用相同的功能来设置保存要处理的工作簿的文件夹。

我想在测试后收到一些反馈。和澄清问题，如果不够清楚......但应该是学习和自己做的正确时间。如果您无法处理，我仍然会帮助您，但只是提供一些建议。否则，如果只使用你看不懂的代码，你永远学不会编码！

已编辑：

请使用数组测试（并学习）下一种方法。您可以在不更改代码的情况下更改要返回的值的范围...

Sub DataTransferArrayVariant()
    Dim FolderPath As String, FilePath As String, Filename As String, iRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, shTF As Worksheet
    
    FolderPath = ChooseFolder("Please select the Folder path", msoFileDialogFolderPicker)
    
    FilePath = FolderPath & "\Business Case (*.xls*" 'you wrongly copied this line...

    Set wb2 = ThisWorkbook
    Set shTF = wb2.Worksheets("Datainput")

    Filename = Dir(FilePath)
    iRow = 41 'starting row to be filled
    
    'The new arrays approach:_________________________________________________________________________
    Dim arrAddr1, arrAddr2, arrFin1, arrFin2, k1 As Long, k2 As Long, i As Long
    'let us say that the information regarding the cells where from the value to be taken will be in the range "G33:AO33"
    'first cell keeps the sheet name
    'the second range will be "AQ33:HK33". The same about the first cell (the sheet  name)
    arrAddr1 = shTF.Range("G33:AO33")     'change here the row according to your case
    arrAddr2 = shTF.Range("AQ33:HK33")   'change here the row according to your case
    ReDim arrFin1(1 To 30, 1 To UBound(arrAddr1, 2) + 4) 'redim first array to collect the processing values (from first sheet)
    ReDim arrFin2(1 To 30, 1 To UBound(arrAddr2, 2) + 1) 'redim second array to collect the processing values (from second sheet)
    
    k = 1  'initialize the first row of arrays
    Do While Filename <> ""
        Set wb1 = Workbooks.Open(FolderPath & "\" & Filename)
        'process the first sheet necessary ranges:_ _ _ _ _ _ _ _ _
        With wb1.Worksheets(arrAddr1(1, 1))
            arrFin1(k, 1) = wb1.Name         'workbook name
            arrFin1(k, 4) = arrAddr1(1, 1)    'worksheet name
            For i = 2 To UBound(arrAddr1, 2)
                 arrFin1(k, i + 3) = .Range(arrAddr1(1, i)) 'put in the array each necessary values from the necessary ranges
            Next i
        End With
        '_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
        'process the second sheet necessary ranges:__ __ __ __ __
        With wb1.Worksheets(arrAddr2(1, 1))
            arrFin1(k, 1) = arrAddr2(1, 1)    'worksheet name
            For i = 2 To UBound(arrAddr2, 2)
                 arrFin2(k, i) = .Range(arrAddr2(1, i))  'put in the array each necessary values from the necessary ranges
            Next i
        End With
        '__ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __
        k = k + 1 'increment the array row
        
        wb1.Close False   'close the input workbook

        Filename = Dir    'determine the next workbook to be open
    Loop
    '______________________________________________________________________________________________
    'Drop the arrays content in the appropriate cells (column D:D and AQ:AQ):
    shTF.Range("D" & iRow).Resize(UBound(arrFin1), UBound(arrFin1, 2)).Value = arrFin1
    shTF.Range("AQ" & iRow).Resize(UBound(arrFin2), UBound(arrFin2, 2)).Value = arrFin2
End Sub

假设：

应返回值的单元格地址的定义必须存在于目标工作簿工作表（“数据输入”）的一行中。上面的代码使用第 33 行。如果您要使用另一个，请调整范围（“G33:AO33”和“AQ33:HK33”）。这些范围在其第一列中包含要从中提取数据的工作表名称。

请测试一下，尝试理解它的含义（我评论了所有的行）并发送一些反馈。如果有什么不清楚的地方，尽管问！