VBA loop through files, copy & paste cells to specific destination in master workbook

[michelernqm]

My main objective is to loop through a folder with several excel files, each containing the exact same file layout, getting data from certain tabs and specific cells from each defined tab. In my image attached, I need to copy data from tab named "q21" cell "D33" from each spreadsheet in the folder (ex. Prod 1, Prod 2, Prod 3, Prod 4, etc.(all are xlsx files) and pasted to the according cells (in the image) D2, E2, F2, and G2 in the master workbook. I need this to carry on with rows 3, 4, etc with the specified cells. Any help would be appreciated, as I am trying different macros with no success. Thank you.

 

[John_w]

Try this macro, changing the folderPath string to the folder containing the workbooks.

Public Sub Copy_Cells_From_All_Workbooks()

    Dim folderPath As String
    Dim fileName As String
    Dim fromWorkbook As Workbook
    Dim copyCells As Variant
    Dim destCell As Range
    Dim c As Long, r As Long
    
    'Folder containing the 'Prod n' workbooks
    
    folderPath = "C:\path\to\Workbooks\"                                 'CHANGE THIS
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    With ThisWorkbook.ActiveSheet
        copyCells = .Range("A2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
        Set destCell = .Range("D1")
    End With
    
    Application.ScreenUpdating = False
    
    'Copy from workbooks matching *.xlsx
    
    fileName = Dir(folderPath & "*.xlsx")
    c = 0
    While fileName <> vbNullString
        Set fromWorkbook = Workbooks.Open(folderPath & fileName)
        destCell.Offset(0, c).Value = Left(fileName, InStrRev(fileName, ".") - 1)
        For r = 1 To UBound(copyCells)
            destCell.Offset(r, c).Value = fromWorkbook.Worksheets(copyCells(r, 1)).Range(copyCells(r, 3)).Value
        Next
        fromWorkbook.Close SaveChanges:=False
        DoEvents
        c = c + 1
        fileName = Dir
    Wend
    
    destCell.Resize(, c).EntireColumn.AutoFit
    
    Application.ScreenUpdating = True
    
    MsgBox "Finished"
    
End Sub

 

[michelernqm]

Should there be a definition specifying the sheet name to which tab to copy from? There are 30+ tabs in the workbooks to which I am copying from.
I am getting an error see image below.

 

[John_w]

Should there be a definition specifying the sheet name to which tab to copy from?

Isn't that shown in your OP? On the active sheet, cells A2:A5 contain the source sheet names and C2:C5 contain the source cells. The code is written accordingly.

Your image doesn't show the error.

 

[michelernqm]

Should there be a definition specifying the sheet name to which tab to copy from? There are 30+ tabs in the workbooks to which I am copying from.
I am getting an error see image below.

 

[michelernqm]

I guess I am confused of what I am doing wrong

 

[John_w]

The subscript out range error suggests the source sheet name doesn't exist.

Add this after the For r = line and see if it helps to explain what the code is doing.

            MsgBox "Copy from: " & fromWorkbook.FullName & vbCrLf & _
                "Sheet name: " & copyCells(r, 1) & vbCrLf & _
                "Cell: " & copyCells(r, 3)