VBA Pull/Vlook up to same range on Dynamic amount of workbooks

[CBG05QB]

Ok so heres the deal,
I have a folder which houses weekly files for the year,
the files are in the exact same format evey week.
The file shows man hours worked on overtime.
I want to pull the same 4 range's from one sheet in each workbook into a summay sheet that calculates my YTD expenses for OT.

I need help in writing a VBA code that targets the folder and tells it to pull "X" range, "Y" range ect... from all the files in the folder, that way it stays dynamic as more files get added. Does anyone have a suggestion for me.

I currently have no code written RE this since I dont know where to start, I am very much a novice in VBA. (I am a quick learning novice though).

Any help yould be much appreciated.

Thanks in advance
Brad

[CBG05QB]

Ok, so I have looked into this issue a bit more, and I found some code that was helpful, but I still cant get it right.

Sub Consolidate()

Dim fName As String
Dim fPath As String
Dim fPathDone As String
Dim LR As Long
Dim NR As Long
Dim wbData As Workbook
Dim wsData As Worksheet
Dim wsMaster As Worksheet
Dim rngToCheck As Range
'Setup
    Application.ScreenUpdating = False  
    Application.EnableEvents = False   
    Application.DisplayAlerts = False   

With ActiveWorkbook
    
    Set wsMaster = Sheets("Master")    'sheet report is built into
    
End With
With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .Cells.Clear
        NR = 1
    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If

'Path and filename (edit this section to suit)
    fPath = "C:\2011\Files\"            'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xls*")        'listing of desired files, edit filter as desired

'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file

            'Sheets("Formula").Select
            'LR = ActiveSheet.UsedRange.Rows.Count
            'Set rngToCheck = .Range(.Cells(1, 1), .Cells(LR, 1))

    'With rngToCheck
        '.AutoFilter Field:=1, Criteria1:=">0"
        '.SpecialCells(xlCellTypeVisible).Offset(1).EntireRow.Copy 
         wsData.Paste (NR)
    'End With
     


The Red is the code I worte and want to happen, but when I run this macro nothing occurs, but it dosent debug either.  If I run the macro in the original authers form is works, but I get the wrong data. 



'************************************************************************************************
        'This is the section to customize, replace with your own action code as needed
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
            If NR = 1 Then                              'copy the data AND titles
                Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
            Else                                        'copy the data only
                Range("A2:A" & LR).EntireRow.Copy .Range("A" & NR)
            End If
'*************************************************************************************************
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            'NR = LR + 1
            Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
            fName = Dir                                       'ready next filename
         
            '.Paste (NR)
                    
        End If
    Loop
End With

ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub