Macro that adds records

[john]

I haven't made any macro's in Excel but I was wondering if the following is
possible.

I would like to do the following:

1. Open Excel
2. Run a macro that:
3. Opens a particular file called c:\MyFile.xls, and
4. Opens every Excelfile in a particular folder called C:\ToBeProcessed\
5. For every Excelfile it should copy only the 2nd row (the 1st one with
data), and
6. Paste the whole row after the last record of c:\MyFile.xls

Thanks in advance for any help,
john

 

[crferguson]

Yes, that's possible.

 

[VBA Noob]

Hi,

Ron's site might help

http://www.rondebruin.nl/ado.htm#folder

VBA Noo

 

[john]

And how would I make such a macro? Do you have some sample code?
john

 

[crferguson]

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.

 

[john]

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

 

[john]

Thanks, that will help me to get into writing macro's myself...
john

 

[Ron de Bruin]

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

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

 

[john]

Thanks,
john

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

 

[Ron de Bruin]

Also not in 2007