| Home |
| Search |
| Today's Posts |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro that adds records
Also not in 2007
-- Regards Ron de Bruin http://www.rondebruin.nl "john" wrote in message ... Thanks, john "Ron de Bruin" schreef in bericht ... Hi 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" wrote in message ... 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(db lRows + 1 & ":" & dblRows + 1) to ActiveSheet.Paste Destination:=Worksheets(ActiveSheet.Name).Range(d + 1 & ":" & d + 1). Thanks again, john schreef in bericht ups.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(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 |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Is there a macro which adds selected/highlighted cells? | Excel Worksheet Functions | |||
| macro that adds left and right footers | Excel Programming | |||
| Macro that adds then deletes | Excel Programming | |||
| Macro adds 1 to Cell in excel | Excel Programming | |||
| Macro which adds new spreadsheets | Excel Programming | |||
Threaded Mode
