See also this add-in and the link to the code page on the bottom of the page
http://www.rondebruin.nl/merge.htm

Working OK in 2007

   If you wanted a VBA solution, this code will take all of the
workbooks in a given folder and put them together into one worksheet
in a new workbook called "merged.xls" which is placed on your desktop.
Simply create a folder on your desktop called "merged" and place all
of the workbooks there. It assumes there is only one sheet per
workbook, and your desktop folder is located at "C:\Documents and
Settings\username\Desktop".

   It works in Excel 2003, let me know if it works in 2007. Paste
into a standard module (see http://www.rondebruin.nl/code.htm for
assistance).

Option Explicit
Public Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" ( _
   ByVal lpBuffer As String, _
   nSize As Long) As Long
Public Function Username() As String
Dim lpBuff As String * 1024
GetUserName lpBuff, Len(lpBuff)
Username = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
End Function
Sub MergeWorkbooks()
'
' this routine will go to a folder called 'merged' on your desktop and
merge all the workbooks in the folder into one
' super workbook called "merged.xls" on your desktop
'
Dim NewWB As Excel.Workbook
Dim FName As String
Dim myLastCell As String, myLastRow As Long, myLastColumn As Long
Dim myRange As String
Dim directoryfiles()
Dim count As Integer
Dim FileN As String
Dim UserN As String, AddRange As Excel.Range
Dim i As Long
Dim rng As Excel.Range
Dim A As Long

UserN = Username

Application.ScreenUpdating = False

' basic error checking
If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged.xls")
<> "" Then
   MsgBox ("MERGED.XLS already exists, clear it out before running
this macro"), vbCritical
   Exit Sub
End If

If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\*.xls")
= "" Then
   MsgBox ("No XLS files are in the directory." & vbCrLf & "Put some
workbooks there first."), vbCritical
   Exit Sub
End If

' build an array of filenames for later processing
FileN = Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\")
Do
   If FileN <> "" Then
       ReDim Preserve directoryfiles(count)
       directoryfiles(count) = FileN
       count = count + 1
   End If
   FileN = Dir
Loop While FileN <> ""

Set NewWB = Workbooks.Add
ActiveWorkbook.SaveAs "C:\Documents And Settings\" & UserN & "\Desktop
\" & "merged.xls", FileFormat:=xlNormal

Set AddRange = Workbooks("merged.xls").Worksheets(1).Range("A65536")

For i = 0 To UBound(directoryfiles())
   Workbooks.Open ("C:\Documents And Settings\" & UserN & "\Desktop
\merged\" & directoryfiles(i))

   Set rng = ActiveSheet.UsedRange.Rows
   With WorksheetFunction
       For A = rng.Rows.count To 1 Step -1
           If .CountA(rng.Rows(A).EntireRow) = 0 Then
rng.Rows(A).EntireRow.Delete
       Next A
   End With

       myLastRow = Cells.Find("*", [A1], , , xlByRows,
xlPrevious).Row
       myLastColumn = Cells.Find("*", [A1], , , xlByColumns,
xlPrevious).Column
       myLastCell = Cells(myLastRow, myLastColumn).Address
       myRange = "a1:" & myLastCell
       Range(myRange).Copy Destination:=AddRange.End(xlUp).Offset(2,
0)
       Workbooks(directoryfiles(i)).Close savechanges:=False
Next i

Workbooks("merged.xls").Close savechanges:=True

MsgBox ("Merge complete!" & vbCrLf & vbCrLf & UBound(directoryfiles())
+ 1 & " workbooks were merged."), vbInformation

If MsgBox("Would you like to delete the separate workbooks?", vbYesNo)
= vbYes Then
   For i = 0 To UBound(directoryfiles())
       Kill ("C:\Documents And Settings\" & UserN & "\Desktop\merged
\" & directoryfiles(i))
   Next i
   MsgBox ("Done!"), vbInformation
End If

Set NewWB = Nothing
Set AddRange = Nothing
Set rng = Nothing
Application.ScreenUpdating = True
End Sub

---

HTH,
JP

On Feb 19, 2:38 pm, "Mark S" <mm...@pacbell.net> wrote: