VBA: Copy & Paste specific cells from Folderpicker identified files, to Filepicker identified target file

0
votes

My Question: I want to copy specific cells, from multiple workbooks (Called: Business Case (1) and rising), and within these workbooks, i want to copy data from 2 different worksheets (named "Summary" and "Business Case Input Sheet"). I dont know how to write the code to copy and paste the data correcly?

The place i want to copy from :

Filename:"Business Case (x)"

Sheet: "Summary"

Cells:

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

And from the same workbook (Business Case (X)), but another sheet i want to get the following.

Sheet: "Business Case Input sheet"

Cells:

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

And the recieving file is named:"Portfolio Overview"

Sheet:" Datainput Cells for the Business case 1: H41:HK41

Cells for the Business case 1: H42:HK42

Cells for the Business case 1: H43:HK43

Example

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.

.... and so on, one row in the target file, for each business case it retrieves data from.

As stated earlier; i dont know how to write the copy/paste code, that goes across multiple workbooks, and 2 sheets, to retrieve the data to the target file.

My current code is below:

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

Best Michael

1
excelvbaexcel-formula
I am afraid that without some clarifications, your question will never be understood... It happens I know something about it from your previous one, but I still do not understand what is to be done. So, I would suggest editing your question and place a picture of the sheet where the necessary data to be copied. Then, explain where the data to be placed. Putting the data in the range "H41:HK41" looks obviously wrong. Iterating between many workbooks and copying the data extracted from each of them ** in the same range** will overwrite the previous work, keeping only the ones form the last one. – FaneDuru
You have 34 cells. You have a repeating E27. So I don't know how this should fit in H41:HK41. Please do clarify if it is a row or a column to be created and which row or column is the data from the next worksheet and then the next workbook to be written to. – VBasic2008
@FaneDuru - See the updated question. Im am sorry it seems hard to explain my issue - i have done my best. As stated in the headline: I want to get multiple cells of data, from 2 different sheets, from X amount of workbooks, that are all in the same template format. My problem is to make the copy/paste function correct, that loops through the different sheets and copies the data and returns it to the target file – Michael Madsen
@VBasic2008 - Thanks for finding my first error ;) - It now corrected and i have updated the question. I need to copy the specific cells, from the specific sheets, and then dump the data into the target file. For Each business case that is read, it needs to create 1 new row for the new dataset, so the data does not "stack"/overwrite eachother. So e.g.: copy the data from all the above listed cells, and dump them from : Cells for the Business case 1: H41:HK41 Cells for the Business case 2: H42:HK42 Cells for the Business case 3: H43:HK43 – Michael Madsen
The range H:HK contains 212 columns. The first sample contains 34 addresses and the second sample 175 addresses which is 209. Could you specify where exactly those values are to be copied, e.g. H:AO and AP:HH? – VBasic2008

1 Answers

1
votes

Please, try the next code. It will fill only the first part (until AO inclusively). It is done in order to show you the way to be followed. The code assumes that the target workbook is the one keeping the VBA code. I only like to believe that I corrrectly understood what you really want:

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

Please, use the same function to set the folder keeping the workbooks to be processed.

I would like to receive some feedback after testing it. And clarification questions, if something not clear enough... But it should be the right time to learn and do it by yourself. If you cannot handle it, I will still help you, but only with pieces of advice. Otherwise, you will never learn coding if only use codes which you cannot understand!

Edited:

Please, test (and learn) the next approach, using arrays. You can change the ranges where from the values to be returned without changing the code...

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

Assumptions:

The definition of the cells address where from the values should be returned, must exist in a row of the target workbook working sheet ("Datainput"). The above code uses the row 33. If you will use another one, please adapt the ranges ("G33:AO33" and "AQ33:HK33"). These ranges contains in their first column the sheet name where the data will be extracted from.

Please, test it, try understanding its meaning (I commented all the lines) and send some feedback. If something not clear enough, do not hesitate to ask!