Phil,

This code will go through a folder called "merged" on your desktop
(assumed C:\Documents And Settings\username\Desktop\) and put all of
the workbooks it finds together on one large spreadsheet called
"merged.xls". It assumes that each workbook is in a tabular format.
This will only work on XL 2003, one of your posts suggested that the
files might be in 2007 format, in which case this code may not work.


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()
'
' click on the email and "save attachments" to a folder called
"merged" which you will
' create on your desktop
'
' this routine will go to that folder 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
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("A6553 6")

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

Run "Del_Empty_Rows"
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

Set NewWB = Nothing
Set AddRange = Nothing
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

Application.ScreenUpdating = True
End Sub


Check out http://www.rondebruin.nl/code.htm if you need help pasting
the code into the appropriate place.

HTH,
JP



On Jan 22, 11:43*am, Phil Smith wrote:
I have about 200 individual excel files. *each has a single worksheet,
none is over a hundred rows, 8 coloumns.

Is there a simple way to collect all of those spreadsheets, (the
contents of a single directory) into one workbook, importing them into
individual sheets?

Is there a sigle way to just append the data in each of thos worksheets

into a single worksheet as well?

Working with Excell 2003 here.

Thanx