Consolidate Data from 1 Range on 1 Sheet in Multiple Workbooks to Master Workbook Sheet

I realise this is likely a mamoth task for an Excel VBA and it should really be a database query, however at present, my only option is multiple linked ranges, or a macro to pull to one range.

What I need to do, is to copy (not cut, as they need to persist on the original document) any populated rows in range D9:X353 on a sheet named ROI, from all workbooks in a certain folder, and paste values into a data sheet on a master report (empty cells below headers on master start at A2 to U2 and continue as required to capture all data).

What I envisage the macro doing is as follows:

- On Data sheet in Master Report, find first populated cell below header (row 1)
- Select first populated cell to last populated cell in range (A to U) and delete contents
- Select first empty row in range below header (A2)
- Open first workbook in Individual Trackers folder
- Select sheet 'ROI'
- Select populated rows in range D9:X135
- Copy
- Paste values into first empty row in range on Master Report, Data sheet
- Close Individual Trackers workbook
- Find next empty row and repeat until all workbooks in Individual Trackers folder has been copied and pasted.

Is this doable, or am I better off just leaving my data sheet as it is at the moment and adding a new linked range in for each new individual tracker created?

Many thanks for any help!

Jenn

This should do it:

Option Explicit

Sub ROIConsolidation()
Dim wsMstr As Worksheet, wb As Workbook
Dim fPATH As String, fNAME As String, NR As Long, LR As Long

Set wsMstr = ThisWorkbook.Sheets("Data")                    'macro stored in master workbook
fPATH = "C:\Individual Trackers\"                           'edit as needed, remember the final \ in this string

If MsgBox("Clear current data sheet", vbYesNo) = vbYes Then 'option to clear the current master sheet, except headers
    wsMstr.UsedRange.Offset(1).Clear
    NR = 2
Else                                                        'otherwise we append to old data
    NR = wsMstr.Range("A" & Rows.Count).End(xlUp).Row + 1
End If

fNAME = Dir(fPATH & "*.xlsx")                               'get the name of the first file in the fPATH

On Error GoTo Next1                                         'if no ROI sheet is found, will skip the copy commands
Do While Len(fNAME) > 0
    Set wb = Workbooks.Open(fPATH & fNAME)                  'open the found file

    With wb.Sheets("ROI")
        LR = .Range("D" & .Rows.Count).End(xlUp).Row        'find the last row of data
        If LR > 8 Then
            .Range("D9:X" & LR).Copy wsMstr.Range("A" & NR) 'copy rows to master sheet
            NR = wsMstr.Range("A" & Rows.Count).End(xlUp).Row + 1       'set NR for next paste job
        End If
    End With
Next1:
    wb.Close False                                          'close found file

    fNAME = Dir                                             'get next filename from fPATH
Loop                                                        'repeat process

End Sub

WE can apply an AUTOFILTER to the source workbooks. Since we're copying from row 9 down, this means we can use row 8 for the "filter". So, you want to filter everything out that is blank in column D?

Option Explicit

Sub ROIConsolidation()
Dim wsMstr As Worksheet, wb As Workbook
Dim fPATH As String, fNAME As String, NR As Long, LR As Long

Set wsMstr = ThisWorkbook.Sheets("Data")                    'macro stored in master workbook
fPATH = "C:\Individual Trackers\"                           'edit as needed, remember the final \ in this string

If MsgBox("Clear current data sheet", vbYesNo) = vbYes Then 'option to clear the current master sheet, except headers
    wsMstr.UsedRange.Offset(1).Clear
    NR = 2
Else                                                        'otherwise we append to old data
    NR = wsMstr.Range("A" & Rows.Count).End(xlUp).Row + 1
End If

fNAME = Dir(fPATH & "*.xlsx")                               'get the name of the first file in the fPATH

On Error GoTo Next1                                         'if no ROI sheet is found, will skip the copy commands
Do While Len(fNAME) > 0
    Set wb = Workbooks.Open(fPATH & fNAME)                  'open the found file

    With wb.Sheets("ROI")
        .Rows(8).AutoFilter 4, "<>"                         'only show rows that are not blank in column D
        LR = .Range("D" & .Rows.Count).End(xlUp).Row        'find the last row of data
        If LR > 8 Then
            .Range("D9:X" & LR).Copy                        'copy rows to master sheet
            wsMstr.Range("A" & NR).PasteSpecial xlPasteValuesAndNumberFormats       'removes formulas and cell formats
            NR = wsMstr.Range("A" & Rows.Count).End(xlUp).Row + 1       'set NR for next paste job
        End If
    End With
Next1:
    wb.Close False                                          'close found file

    fNAME = Dir                                             'get next filename from fPATH
Loop                                                        'repeat process

End Sub