Consolidate From Multiple to Multiple Worksheets

• The only immediate mistake I found is the destination ‘row-business’ i.e. replace all occurrences of lastRowMonthly with rowOffset and remove the duplicate variable declaration (Dim).
• Here’s what I came up with while playing around.

Standard Module, e.g. Module1, or renamed to e.g. modMain

Option Explicit

Sub ConsolidateClientData()
    
    ' Define constants.
    Const SRC_FOLDER_PATH As String = "C:YourPathToClientWorkbooks"
    Const SRC_FILE_PATTERN As String = "*.xlsx"
    Dim SRC_CELLS() As Variant: SRC_CELLS = VBA.Array("C6", "F2")
    Dim SRC_COLUMNS() As Variant: SRC_COLUMNS = VBA.Array("A", "F", "K")
    Const SRC_ROWS As String = "11:22"
    Const DST_COLUMN As String = "A"
    
    ' Reference the destination workbook (monthly).
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code

    ' Retrieve the name of the first file (workbook) in the source folder.
    Dim SourceFileName As String:
    SourceFileName = Dir(SRC_FOLDER_PATH & SRC_FILE_PATTERN)
    
    ' Exit if no file was found.
    If Len(SourceFileName) = 0 Then
        MsgBox "No files matching the pattern """ & SRC_FILE_PATTERN _
            & """ in """ & SRC_FOLDER_PATH & """ found!", vbExclamation
        Exit Sub
    End If
    
    ' Calculate the number of source rows
    ' to be able to define the array.
    Dim sRowsCount As Long:
    sRowsCount = dwb.Worksheets(1).Range(SRC_ROWS).Rows.Count
    
    ' Calculate the number of source (destination) columns
    ' to be able to define the array.
    Dim ColumnsCount As Long:
    ColumnsCount = UBound(SRC_CELLS) + UBound(SRC_COLUMNS) + 2 ' zero-based
    
    ' Define the array.
    Dim Data() As Variant: ReDim Data(1 To sRowsCount, 1 To ColumnsCount)
    
    ' Create an instance of the 'clientData' user-defined type.
    Dim client As clientData
    
    ' Populate its constant properties,
    ' the arrays holding the source cell addresses and source columns.
    With client
        .CellAddresses = SRC_CELLS
        .ColumnStrings = SRC_COLUMNS
    End With
    
    Application.ScreenUpdating = False
    
    ' Declare additional variables.
    Dim swb As Workbook, sws As Worksheet, dws As Worksheet
    Dim dRowsCount As Long ' the number of non-blank rows to copy
    
    ' For each file apply the same logic...
    Do While SourceFileName <> ""
        ' Open the source (client) workbook.
        Set swb = Workbooks.Open(SRC_FOLDER_PATH & SourceFileName)
        ' Loop through the WORKSHEETS of the source workbook.
        For Each sws In swb.Worksheets
            ' Reference the corresponding destination sheet.
            RefWorksheet dwb, dws, sws.Name
            If Not dws Is Nothing Then ' the destination sheet was found
                ' Read from the source sheet (ranges).
                PopulateClient client, sws, SRC_ROWS
                ' Write to the destination array.
                PopulateArray client, Data, dRowsCount, sRowsCount
                ' Write to the destination sheet (range).
                PopulateRange dws, DST_COLUMN, Data, dRowsCount, ColumnsCount
            Else ' the destination sheet was not found
                Debug.Print "No sheet named """ & sws.Name _
                    & """ found in workbook """ & dwb.Name & "!"
            End If
        Next sws
        swb.Close SaveChanges:=False ' it was just read from
        SourceFileName = Dir ' read next file (workbook) name
    Loop
    
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Consolidation Complete"

End Sub

Standard Module, e.g. Module2, or renamed to e.g. modHelp

Option Explicit

' Indices of the Source Arrays
Private Enum sCells
    ClientName
    ServiceType
End Enum
Private Enum sColumns
    DayService
    Hours
    Miles
End Enum

' Actual Destination Columns
Private Enum dColumnIDs
    DayService = 1
    ClientName
    ServiceType
    Miles
    Hours
End Enum

' Each Client (Worksheet)
Type clientData
    ' Constant
    CellAddresses() As Variant
    ColumnStrings() As Variant
    ' Each Sheet
    Name As String
    ServiceType As String
    DayService() As Variant
    Miles() As Variant
    Hours() As Variant
End Type

Sub RefWorksheet( _
        ByVal wb As Workbook, _
        ByRef ws As Worksheet, _
        ByVal SheetName As String)
    Set ws = Nothing
    On Error Resume Next
        Set ws = wb.Worksheets(SheetName)
    On Error GoTo 0
End Sub

Sub PopulateClient( _
        ByRef client As clientData, _
        ByVal ws As Worksheet, _
        ByVal RowsAddress As String)
    With client
        .Name = ws.Range(.CellAddresses(sCells.ClientName)).Value
        .ServiceType = ws.Range(.CellAddresses(sCells.ServiceType)).Value
        Dim rg As Range: Set rg = ws.Rows(RowsAddress)
        .DayService = rg.Columns(.ColumnStrings(sColumns.DayService)).Value
        .Hours = rg.Columns(.ColumnStrings(sColumns.Hours)).Value
        .Miles = rg.Columns(.ColumnStrings(sColumns.Miles)).Value
    End With
End Sub

Sub PopulateArray( _
        client As clientData, _
        ByRef Data() As Variant, _
        ByRef dRowsCount As Long, _
        ByVal sRowsCount As Long)
    With client
        dRowsCount = 0 ' reset ('ByRef')
        Dim sRow As Long
        For sRow = 1 To sRowsCount
            If Len(CStr(.DayService(sRow, 1))) > 0 Then ' not blank
                dRowsCount = dRowsCount + 1
                Data(dRowsCount, dColumnIDs.DayService) = .DayService(sRow, 1)
                Data(dRowsCount, dColumnIDs.ClientName) = .Name
                Data(dRowsCount, dColumnIDs.ServiceType) = .ServiceType
                Data(dRowsCount, dColumnIDs.Miles) = .Miles(sRow, 1)
                Data(dRowsCount, dColumnIDs.Hours) = .Hours(sRow, 1)
            End If
        Next sRow
    End With
End Sub

Sub PopulateRange( _
        ByRef ws As Worksheet, _
        ByVal Col As String, _
        Data() As Variant, _
        ByVal RowsCount As Long, _
        ByVal ColumnsCount As Long)
    If RowsCount > 0 Then
        Dim cell As Range:
        Set cell = ws.Cells(ws.Rows.Count, Col).End(xlUp).Offset(1)
        cell.Resize(RowsCount, ColumnsCount).Value = Data
    End If
End Sub