Loop through folders - copy data from files to main file - vba

Question

I want to do loop through folders and subfolders.
It works in my code. My next step is doing check - if specified cell in 4th column is not empty(in every file in subfolders), then copy values from files to my main file(for example ActiveWorkbook.ActiveSheet) - append.
In every try i have problems, now it is "Object variable or With block variables not set." But doing set makes new error.
Can someone help?
Regards
Sub DoFolder()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim FileName As String
Dim PathName As String
Dim Wb As Workbook
Dim newbook As Worksheet
Dim i As Integer
Dim lastRow As Long
Dim col As Range, coll As Range
Dim someRange As Range
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("Y:\MDM\__ZADANIA\LISTOWANIE\Archiwum\") 'obviously replace
Application.ScreenUpdating = False
'Nagłówki do nowego pliku z danymi
Set newbook = ActiveWorkbook.ActiveSheet
With newbook
.Columns("A").Cells(1, 1) = "Subsystem"
.Columns("B").Cells(1, 1) = "MGB"
.Columns("C").Cells(1, 1) = "EAN Zakupowy"
.Columns("D").Cells(1, 1) = "Liczba jednostek sprzedaży w kartonie"
.Columns("E").Cells(1, 1) = "Ilość sztuk w jednostce sprzedaży"
.Columns("F").Cells(1, 1) = "Nazwa pliku"
.Columns("G").Cells(1, 1) = "Katalog pliku"
End With
'Fitowanie kolumn
With newbook.Columns("A:G")
.AutoFit
End With
'zczytywanie ifnormacji z formatek po foldrach i dodawanie do istniejącego pliku
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder
Next oSubfolder
For Each oFile In oFolder.Files
Set Wb = Nothing
Set Wb = Workbooks.Open(oFile)
Wb.Windows(1).Visible = False
For i = 15 To 515
Set someRange = newbook.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not someRange Is Nothing Then
lastRow = someRange.Row
Else
lastRow = 1
End If
If Wb.Sheets("Dane_Dostawcy").Cells(i, 4) <> "" Then
newbook.Cells(lastRow + 1, 1).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
newbook.Cells(lastRow + 1, 2).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
newbook.Cells(lastRow + 1, 3).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 30).Value
newbook.Cells(lastRow + 1, 4).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 56).Value
newbook.Cells(lastRow + 1, 5).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 14).Value
newbook.Cells(lastRow + 1, 6).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
newbook.Cells(lastRow + 1, 7).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
Else
GoTo MyStatement
End If
MyStatement:
Next i
Next oFile
Loop
Application.ScreenUpdating = True
End Sub

Answer 1

It is producing an error because it cannot find anything, and you are asking for the .Row of that anything.
This is a way to go around it:
Dim someRange As Range
Set someRange = newbook.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not someRange Is Nothing Then
lastRow = someRange.Row
Else
lastRow = 1
End If
Thus it only gives the row value to lastRow in case that it has found something. Based on your business logic, if it does not find anything the row could be the first one.
Second Option for the error (thanks #QHarr) - you have to declare dim lastRow as Long and not as a range.