I looked at others codes but I am still running in circles for
probably some obvious error.
From one Folder, many Workbooks, single Worksheet, same format,
append All non blank rows in a single worksheet.

Public Sub Import()
Dim fso As Object
Dim Source As Object ' Folder
Dim WB As Object ' Source Workbook
Dim WS As Object ' Destination Workbook
Dim LastRow As String
Dim R1 As Integer ' Destination WorkSheet Start Row

R1 = 3
Set fso = CreateObject("Scripting.FileSystemObject")
Set Source = fso.GetFolder("C:\USB20FD (E)\TestFolder1")

Set WS = ThisWorkbook.Sheets(1)
For Each WB In Source.FILES
If LCase(Right(WB.Name, 4)) = ".xls" Then
Workbooks.Open Filename:=WB.Path
Cells.UnMerge
LastRow = Range("H65335").End(xlUp).Row
Range("H1").Select ' Test Column to decide whether to Import
or not
Do
If IsNumeric(Left(ActiveCell, 2)) = True Or ActiveCell = " -
" Then
WS.Cells(R1, 1).Value = Range("C7") '
Project Name
WS.Cells(R1, 2).Value = ActiveCell ' Code
WS.Cells(R1, 3).Value = ActiveCell.Offset(0, 5) ' Date
WS.Cells(R1, 4).Value = ActiveCell.Offset(0, 6) ' Cost
Else
GoTo LINE1
End If
R1 = R1 + 1
LINE1:
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Row = LastRow
Workbooks(WB.Name).Close False
End If
Next WB
End Sub

I am still a Newbie and I need to pass this hurdle. Help appreciated,
Celeste.