VBA: Next Empty Row Randomly Overwriting Some Rows - excel

Question

I have a list of files:
They share one common format, only have one sheet, but can have multiple rows with data. They are meant to be opened, all cells with data copied, and then pasted to a sheet called Addresses. Like this:
However what I'm getting is this:
Now I have stepped in and noticed that my other data IS being put in the destination, it's just getting overwritten (in what appears to be a random pattern). Here's the code I used:
Option Explicit
Sub AddressListing()
Dim Cell As Range
With Worksheets("ghgh")
For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
If Len(Dir(Cell.Value)) Then
With Workbooks.Open(Cell.Value)
Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
ThisWorkbook.Worksheets("Addresses").Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Close SaveChanges:=False
End With
Else
MsgBox "File not found: " & Cell.Value
End If
Next Cell
End With
'Call RemoveViaFilter
End Sub
In an effort to combat this and not waste everyone's time, I created a NextRow variable to find the next blank row in the workbook. It still didn't work. I don't get an error message, the data is simply input the same way.
Here's the code with NextRow:
Option Explicit
Sub AddressListing2()
Dim Cell As Range
Dim NextRow As Long
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
With Worksheets("ghgh")
For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
If Len(Dir(Cell.Value)) Then
With Workbooks.Open(Cell.Value)
Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
ThisWorkbook.Worksheets("Addresses").Range("A" & NextRow)
.Close SaveChanges:=False
End With
Else
MsgBox "File not found: " & Cell.Value
End If
Next Cell
End With
'Call RemoveViaFilter
End Sub
I have never encountered that type of error with NextRow. I know 'Find next blank row and put data there' is a common question, which is why I thought NextRow would solve the issue. However, data is still being overwritten and I have not come across any questions that address this.
I don't want defined ranges (like A2:J100 for example) and have purposefully avoided them, because the length of my lists constantly changes. That goes for the rows I want to paste and the rows of file paths.
Any help is much appreciated, I've used the 'find empty row' several times before with no issues, and don't know why it's overwriting data. It seems antithetical to the whole process of find the empty row.

Answer 1

This is where to you put the additional line...
Option Explicit
Sub AddressListing2()
Dim Cell As Range
Dim NextRow As Long
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
With Worksheets("ghgh")
For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
If Len(Dir(Cell.Value)) Then
With Workbooks.Open(Cell.Value)
Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
ThisWorkbook.Worksheets("Addresses").Range("A" & NextRow)
.Close SaveChanges:=False
End With
Else
MsgBox "File not found: " & Cell.Value
End If
'Add line here before going to new loop
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
Next Cell
End With
'Call RemoveViaFilter
End Sub

Answer 2

It is clear that NextRow is not being calculated correctly. Put some validation code in after you calculate it:
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
While Application.WorksheetFunction.CountA(Rows(NextRow)) <> 0
NextRow = NextRow + 1
Wend
This will insure NextRow will be an empty row.