Copiar Datos de múltiples HojasOrigen en una HojaDestino

Compañeros buenos días, pretendo crear una macro que copie los datos de múltiples hojasOrigen y se agregue en una HojaDestino pero me encuentro con el problema que en algunos libros su hojaOrigen en una columna no tiene datos pero las siguiente si, la macro solo me copia hasta la columna sin datos, como puedo corregirlo.

Sub ImportarDatosHojasOrigen()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim WorkBookOrigen As Workbook
Dim wsOrigen As Excel.Worksheet, _
wsDestino As Excel.Worksheet, _
rngOrigen As Excel.Range, _
rngDestino As Excel.Range, _
NombreArchivo As String, _
Carpeta As String
Carpeta = ActiveWorkbook.Path & "\"

nArchivo = 1

NombreArchivo = Dir(Carpeta & "f" & "*.xl*")

Do While Len(NombreArchivo) > 0

Set WorkBookOrigen = Workbooks.Open(Carpeta & NombreArchivo)
NombreArchivo = Dir()
ThisWorkbook.Activate
Set wsOrigen = WorkBookOrigen.Worksheets(1)
Set wsDestino = Worksheets(1)
Const celdaOrigen = "A2"
Set rngOrigen = wsOrigen.Range(celdaOrigen)
wsOrigen.Activate
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Errores:
If Err.Number = 1004 Then
wsOrigen.Activate
rngOrigen.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
End If
For n = 1 To 1
wsDestino.Activate

On Error GoTo Errores

wsDestino.Cells(Columns.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next n
Application.CutCopyMode = False
WorkBookOrigen.Save
WorkBookOrigen.Close
nArchivo = nArchivo + 1
Loop

j = nArchivo - 1

Range("A1").Select

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub