Sub CountRows()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet
Dim sPath As String
Dim lr As Long, lrW As Long
Dim ws As Workbook
Set wb = ThisWorkbook.Sheets("Sheet1")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object associated with the directory
sPath = InputBox("What is the full Path to Search?")
Set objFolder = objFSO.GetFolder(sPath)
'Loop through the Files collection
For Each objFile In objFolder.Files
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
lrW = wb.Range("A" & Rows.Count).End(xlUp).Row + 1
wb.Range("A" & lrW) = ws.Name
wb.Range("B" & lrW) = lr
Next
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub