Make a module in MyFile.xls and paste the following code into it:
Option Explicit
Public sThisFile As String
Public sThisPath As String
Public sFolderName As String
Public sFileName As String
Public dblRows As Double, d As Double
Public FS
Public Sub TransferData()
sThisPath = ActiveWorkbook.Path & "\"
sThisFile = ActiveWorkbook.Name
sFolderName = "C:\ToBeProcessed\"
Dir (sFolderName)
Set FS = Application.FileSearch
With FS
.LookIn = sFolderName
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() 0 Then
'if there are .xls files in the folder then open each one
and copy the row over
For d = 1 To .FoundFiles.Count
sFileName = .FoundFiles(d)
sFileName = Strings.Replace(sFileName, sFolderName, "")
Workbooks.Open Filename:=sFolderName & sFileName
Range("2:2").EntireRow.Select
Selection.Copy
Workbooks(sThisFile).Activate
dblRows = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Paste
Destination:=Worksheets(ActiveSheet.Name).Range(db lRows + 1 & ":" &
dblRows + 1)
Application.DisplayAlerts = False
Workbooks(sFileName).Close SaveChanges:=False
Application.DisplayAlerts = True
Next d
Else
'else, alert the user that no .xls files could be found
MsgBox "No .xls files found...", vbExclamation, "File(s)
Not Found"
End
End If
End With
End Sub
That should do what you describe.
VBA Noob wrote:
Hi,
Ron's site might help
http://www.rondebruin.nl/ado.htm#folder
VBA Noob
--
VBA Noob
------------------------------------------------------------------------
VBA Noob's Profile: http://www.excelforum.com/member.php...o&userid=33833
View this thread: http://www.excelforum.com/showthread...hreadid=573235