Jacob, The 2 missed out lines are still there I'm afraid. Pasted below is the
entire routine which I tested. I have re-checked that the 2 missed out lines
were, as before, the last data lines in 1.xls and 2.xls. My test source 3.xls
had zero data lines (it had only the row1 col headers). Grateful for any
further help to resolve this. Thanks

------------------------
Sub LoopThroughDirectory()

Application.DisplayAlerts = False

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
myPath = fd.SelectedItems(1) & "\"

Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=myPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=myPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
'DoSomething ActiveWorkbook
DoSomething ActiveWorkbook, wbNew
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Sub DoSomething(Book As Workbook, Book1 As Workbook)
Dim ws As Worksheet
Set ws = Book.Sheets(1)
lastrow = ws.Cells(Cells.Rows.Count, "B").End(xlUp).Row

If UCase(Book.Name) = "1.XLS" Then
ws.Rows("1:" & lastrow).Copy
Else
ws.Rows("2:" & lastrow).Copy
End If
lastrowNew = Book1.ActiveSheet.Cells(Cells.Rows.Count, _
"B").End(xlUp).Row
Book1.ActiveSheet.Range("A" & lastrowNew).PasteSpecial
Application.CutCopyMode = False
End Sub