Adjust a macro that consolidates data from multiple workbooks

[dreddster]

Hey guys!
I have a macro that consolidates info from a number of workbooks. However there is data, that I need to be copied only from the first workbook that is opened. It is on sheet "Ref", range is A1:D100 on the source file, copied to sheet "Ref", Range A1:D100 on the consolidation file.
Is this possible? Here is the macro:

Option Explicit

Sub ImportData()
Dim fPATH As String, fNAME As String, NextCol As Long
Dim wsDest As Worksheet, wbSRC As Workbook

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

fPATH = ActiveWorkbook.Path & "\Files\"                'finish this string with a \ don't forget!!
Set wsDest = ThisWorkbook.Sheets("Cons")            'sheet where data will end up
                                                'option to clear the dest sheet
If MsgBox("Are you sure? This will replace all data!", vbYesNo, "Selection") = vbNo Then Exit Sub

    wsDest.Range("B2:DD22").ClearContents
    wsDest.Range("B29:DD49").ClearContents
    wsDest.Range("B57:DD77").ClearContents
    wsDest.Range("B85:DD105").ClearContents
    wsDest.Range("A108:C1000").ClearContents
    NextCol = 2

fNAME = Dir(fPATH & "*.xl*")                    'get first filename

Do While Len(fNAME) > 0
    Set wbSRC = Workbooks.Open(fPATH & fNAME)   'open workbook and copy data
    wsDest.Cells(2, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("C6:C26").Value
    wsDest.Cells(29, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("D6:D26").Value
    wsDest.Cells(57, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("E6:E26").Value
    wsDest.Cells(85, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("F6:F26").Value
    
    wbSRC.Close False                           'close workbook
    fNAME = Dir                                 'get next filename
    NextCol = NextCol + 1
Loop

EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

Thank you in advance!

[JBeaucaire]

Like so:

Option Explicit

Sub ImportData()
Dim fPATH As String, fNAME As String, NextCol As Long
Dim wsDest As Worksheet, wbSRC As Workbook, FirstGroupDone As Boolean

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

fPATH = ActiveWorkbook.Path & "\Files\"                'finish this string with a \ don't forget!!
Set wsDest = ThisWorkbook.Sheets("Cons")            'sheet where data will end up
                                                'option to clear the dest sheet
If MsgBox("Are you sure? This will replace all data!", vbYesNo, "Selection") = vbNo Then Exit Sub

    wsDest.Range("B2:DD22").ClearContents
    wsDest.Range("B29:DD49").ClearContents
    wsDest.Range("B57:DD77").ClearContents
    wsDest.Range("B85:DD105").ClearContents
    wsDest.Range("A108:C1000").ClearContents
    NextCol = 2

fNAME = Dir(fPATH & "*.xl*")                    'get first filename

Do While Len(fNAME) > 0
    Set wbSRC = Workbooks.Open(fPATH & fNAME)   'open workbook and copy data
    If Not FirstGroupDone Then
        ThisWorkbook.Sheets("Ref").Range("A1:D100").Value = wbSRC.Sheets("Ref").Range("A1:D100").Value
        FirstGroupDone = True
    End If
    wsDest.Cells(2, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("C6:C26").Value
    wsDest.Cells(29, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("D6:D26").Value
    wsDest.Cells(57, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("E6:E26").Value
    wsDest.Cells(85, NextCol).Resize(21).Value = wbSRC.Sheets("Data").Range("F6:F26").Value
    
    wbSRC.Close False                           'close workbook
    fNAME = Dir                                 'get next filename
    NextCol = NextCol + 1
Loop

EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

[dreddster]

Thanks Jerry, it is perfect!!