LinkBack URL
About LinkBacksHi
I like to add this
There are problems with Application.FileSearch
Better to use Dir or FileSystemObject
See this page for example code
http://www.rondebruin.nl/copy3.htm
--
Regards Ron de Bruin
http://www.rondebruin.nl
"john" <john@test.com> wrote in message news:4KudnXp9RPFeqXvZnZ2dnUVZ8tednZ2d@casema.nl...
> Thanks a lot! That works like a charm.
>
> Somehow the dblRows variable didn't work because the same record in the destination worksheet got overwritten every time. I was
> very happy to find out that I had to alter the related line:
>
> ActiveSheet.Paste Destination:=Worksheets(ActiveSheet.Name).Range(dblRows + 1 & ":" & dblRows + 1)
>
> to
>
> ActiveSheet.Paste Destination:=Worksheets(ActiveSheet.Name).Range(d + 1 & ":" & d + 1).
>
> Thanks again,
> john
>
> <crferguson@gmail.com> schreef in bericht news:1155933861.621091.31600@m79g2000cwm.googlegroups.com...
>> 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(dblRows + 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
>>
>
>
Register To Reply
Bookmarks