Help with Extract of data from Mutiple files

[hussey1213]

I'm having trouble with the range porition of below. Right now it pulls in B2:B10 but not all files this is pulling from will have the same amount of data to copy. I've tried using B2:B & LastRow but I'm not having luck.


Sub x()

Dim nCount As Long, wbResults As Workbook, rPaste As Range, wsTo As Worksheet, wsFrom As Worksheet, sFolder As String, wsData As Worksheet


With Application.FileDialog(msoFileDialogFolderPicker)
.Show
On Error GoTo errline
sFolder = .SelectedItems(1)
End With

Set wsTo = ThisWorkbook.Sheets("Sheet1")
wsTo.Activate
Set rPaste = Application.InputBox("Enter starting cell to paste", Type:=8)
If rPaste Is Nothing Or rPaste.Count > 1 Then Exit Sub

With Application
.ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False
End With
On Error Resume Next

With Application.FileSearch
.NewSearch
.LookIn = sFolder
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For nCount = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(nCount), UpdateLinks:=0)
For Each wsFrom In wbResults.Worksheets

With wsTo.Range(rPaste.Address)
.Offset(1, 0).Resize(21).Value = wsFrom.Range("B2:B10").Value
End With
Set rPaste = rPaste.Offset(20)
Next wsFrom
wbResults.Close SaveChanges:=True
Next nCount
End If
End With

On Error GoTo 0
With Application
.ScreenUpdating = False: .DisplayAlerts = True: .EnableEvents = True
End With

errline:

End Sub