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
Yes, that's possible.
john wrote:
> 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
Hi,
Ron's site might help
http://www.rondebruin.nl/ado.htm#folder
VBA Noob
And how would I make such a macro? Do you have some sample code?
john
<crferguson@gmail.com> schreef in bericht
news:1155932397.493531.17960@p79g2000cwp.googlegroups.com...
> Yes, that's possible.
>
> john wrote:
>> 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
>
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
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
>
Thanks, that will help me to get into writing macro's myself...
john
"VBA Noob" <VBA.Noob.2cr6gt_1155933619.544@excelforum-nospam.com> schreef in
bericht news:VBA.Noob.2cr6gt_1155933619.544@excelforum-nospam.com...
>
> 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
>
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" <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
>>
>
>
Thanks,
john
"Ron de Bruin" <rondebruin@kabelfoon.nl> schreef in bericht
news:eu0wbD4wGHA.4680@TK2MSFTNGP04.phx.gbl...
> 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" <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
>>>
>>
>>
>
>
Also not in 2007
--
Regards Ron de Bruin
http://www.rondebruin.nl
"john" <john@test.com> wrote in message news:68mdndXn4dTqhXrZRVnysQ@casema.nl...
> Thanks,
> john
>
> "Ron de Bruin" <rondebruin@kabelfoon.nl> schreef in bericht news:eu0wbD4wGHA.4680@TK2MSFTNGP04.phx.gbl...
>> 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" <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
>>>>
>>>
>>>
>>
>>
>
>
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks