Extract data from multiple workbooks to master

I'd like to thank JBeaucaire for the codes he created that I found in this forum but this codes copy the whole data on a sheet

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       9/15/2009     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    Set ws = wbkNew.Sheets("Start") 'sheet report is built into...edit to match
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        ws.Range("A2:A" & Rows.Count).EntireRow.ClearContents
        NR = 2
    Else
        NR = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir             'memorizes the user's current working path
    fPath = "G:\KEEP\Bowden\Imported\"
    fPathDone = "G:\KEEP\Bowden\Imported\Master\"   'optional
    ChDir fPath
    fName = Dir("Book*.xl*")      'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        'Open file
            Set wbkOld = Workbooks.Open(fName)
        'Find last row and copy data
            Sheets(1).Activate
            LR = Range("A" & Rows.Count).End(xlUp).Row   'find the bottom row of data...change to a different column if "A" isn't reliable for spotting this value
            Range("A2:A" & LR).EntireRow.Copy _
                ws.Range("A" & NR)
        'close file
            wbkOld.Close False
        'Next row
            NR = Range("A" & Rows.Count).End(xlUp).Row + 1
        'move file to "imported" folder
            Name fPath & fName As fPathDone & fName         'optional
        'ready next filename
            fName = Dir
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'restores user's original working path
    ChDir OldDir
End Sub

I'm try to find a way to copy range A2:B17 instead of copy the whole data on a sheet.
I tried to change this code to range A2:B17

 LR = Range("A" & Rows.Count).End(xlUp).Row   'find the bottom row of data...change to a different column if "A" isn't reliable for spotting this value
            Range("A2:A" & LR).EntireRow.Copy _
                ws.Range("A" & NR)

but with no luck

try this. It may not work, I cannot test it...

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       9/15/2009     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    Set ws = wbkNew.Sheets("Start") 'sheet report is built into...edit to match
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        ws.Range("A2:A" & Rows.count).EntireRow.ClearContents
        NR = 2
    Else
        NR = ws.Range("A" & Rows.count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir             'memorizes the user's current working path
    fPath = "G:\KEEP\Bowden\Imported\"
    fPathDone = "G:\KEEP\Bowden\Imported\Master\"   'optional
    ChDir fPath
    fName = Dir("Book*.xl*")      'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        'Open file
            Set wbkOld = Workbooks.Open(fName)
        'Find last row and copy data
            Sheets(1).Activate
            'LR = Range("A" & Rows.count).End(xlUp).Row   'find the bottom row of data...change to a different column if "A" isn't reliable for spotting this value
            'Range("A2:A" & LR).EntireRow.Copy ws.Range("A" & NR)
            Range("A2:B17").Copy ws.Range("A" & NR)
        'close file
            wbkOld.Close False
        'Next row
            'NR = Range("A" & Rows.count).End(xlUp).Row + 1
            NR = Range("A" & Cells.count).End(xlUp).Cells + 1
        'move file to "imported" folder
            Name fPath & fName As fPathDone & fName         'optional
        'ready next filename
            fName = Dir
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'restores user's original working path
    ChDir OldDir
End Sub

Thank you pr4t3ek for replying

Unfortunetley there's an error on this code on 'Next row

        NR = Range("A" & Cells.Count).End(xlUp).Cells + 1

It has successfully pasted from the first workbook but then there's a runtime error on the above code before it'll be able to do something with the second workbook (there's only 2 workbook to copy from)

just comment that section and see what happens:

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       9/15/2009     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    Set ws = wbkNew.Sheets("Start") 'sheet report is built into...edit to match
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        ws.Range("A2:A" & Rows.count).EntireRow.ClearContents
        NR = 2
    Else
        NR = ws.Range("A" & Rows.count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir             'memorizes the user's current working path
    fPath = "G:\KEEP\Bowden\Imported\"
    fPathDone = "G:\KEEP\Bowden\Imported\Master\"   'optional
    ChDir fPath
    fName = Dir("Book*.xl*")      'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        'Open file
            Set wbkOld = Workbooks.Open(fName)
        'Find last row and copy data
            Sheets(1).Activate
            'LR = Range("A" & Rows.count).End(xlUp).Row   'find the bottom row of data...change to a different column if "A" isn't reliable for spotting this value
            'Range("A2:A" & LR).EntireRow.Copy ws.Range("A" & NR)
            Range("A2:B17").Copy ws.Range("A" & NR)
        'close file
            wbkOld.Close False
        'Next row
            'NR = Range("A" & Rows.count).End(xlUp).Row + 1
            'NR = Range("A" & Cells.count).End(xlUp).Cells + 1
        'move file to "imported" folder
            Name fPath & fName As fPathDone & fName         'optional
        'ready next filename
            fName = Dir
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'restores user's original working path
    ChDir OldDir
End Sub

Your last code did'nt work but I've found a way round to it.

Instead of comment both section

            'NR = Range("A" & Rows.count).End(xlUp).Row + 1
            'NR = Range("A" & Cells.count).End(xlUp).Cells + 1

I took the comment off the first section and works fine

            NR = Range("A" & Rows.count).End(xlUp).Row + 1
            'NR = Range("A" & Cells.count).End(xlUp).Cells + 1

So thank you very much for your time pr4t3ek

no probs!

i didn't think it would have worked... o well, top work! cheers!