--Modified the DoSomthing Sub.

--In Sub LoopThroughDirectory call DoSomething as below
DoSomething ActiveWorkbook, wbNew

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

If this post helps click Yes
---------------
Jacob Skaria


"Max" wrote:

Many thanks, Sam. Tested using your revision on the sub and it works fine in
picking it up from the dialog, and proceeding from there.

Could I have your help here on the last bit, that stacking part carried out
by Mike's
Sub DoSomething(Book As Workbook). I've pasted below the entire routine
which I just tested. Somehow the stacking sub misses capturing 2 lines, which
I checked were the last data lines in 1.xls and 2.xls. For info, my test
source 3.xls had zero data lines (it had only the row1 col headers). 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
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Sub DoSomething(Book As Workbook)
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row

If ActiveWorkbook.Name = "1.xls" Then
ActiveSheet.Rows("1:" & lastrow).Copy
Else
ActiveSheet.Rows("2:" & lastrow).Copy
End If
lastrowNew = Windows("1234.xls").ActiveSheet.Cells(Cells.Rows.C ount,
"B").End(xlUp).Row
Windows("1234.xls").ActiveSheet.Range("A" & lastrowNew).PasteSpecial
End Sub