Copy several range from all files in folder into several worksheets

A

Adri

Hello
I searched a lot into the newsgroup, but can't find it.
I want to copy a range (or some rows) from all files in a folder.
The copies ranges must be stored in different worksheets (prefered name of
file).
I hope the questions is clear. Can someone help?
Regards, Adri
 
B

Bob Phillips

Hi Adri

Dim FSO As Object

Sub ProcessFiles()
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim this As Workbook
Dim cnt As Long

Set FSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
sFolder = "C:\MyTest"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)

Set Files = Folder.Files
cnt = 1
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=file.Path
this.Worksheets.Add.Name = "File" & cnt
With ActiveWorkbook
.Worksheets(1).Range("A1:C100").Copy _
Destination:=this.Worksheets("File" &
cnt).Range("A1")
.Close
End With
cnt = cnt + 1
End If
Next file

End If ' sFolder <> ""

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
A

Adri

Hi Bob,
Thanks for your reactions, but I can get the code to work.
In folder c:\mytest I put two testfiles (test1.xls and test2.xls).
In c:\ I put a file called test.xls and put the code in a module.
When I run the macro nothing happens, also no erros.
The data (range A1:A100) from the testfiles in C:\mytest should be in the
sheets test1 en test2.
What am I doing wrong.
Adri

Bob Phillips wrote:
| Hi Adri
|
| Dim FSO As Object
|
| Sub ProcessFiles()
| Dim i As Long
| Dim sFolder As String
| Dim fldr As Object
| Dim Folder As Object
| Dim file As Object
| Dim Files As Object
| Dim this As Workbook
| Dim cnt As Long
|
| Set FSO = CreateObject("Scripting.FileSystemObject")
|
| Set this = ActiveWorkbook
| sFolder = "C:\MyTest"
| If sFolder <> "" Then
| Set Folder = FSO.GetFolder(sFolder)
|
| Set Files = Folder.Files
| cnt = 1
| For Each file In Files
| If file.Type = "Microsoft Excel Worksheet" Then
| Workbooks.Open Filename:=file.Path
| this.Worksheets.Add.Name = "File" & cnt
| With ActiveWorkbook
| .Worksheets(1).Range("A1:C100").Copy _
| Destination:=this.Worksheets("File" &
| cnt).Range("A1")
| .Close
| End With
| cnt = cnt + 1
| End If
| Next file
|
| End If ' sFolder <> ""
|
| End Sub
|
|
| || Hello
|| I searched a lot into the newsgroup, but can't find it.
|| I want to copy a range (or some rows) from all files in a folder.
|| The copies ranges must be stored in different worksheets (prefered
|| name of file).
|| I hope the questions is clear. Can someone help?
|| Regards, Adri
 
B

Bob Phillips

Presumably you have modified the code? What does it look like now? And what
Excel version do you have?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
A

Adri

Bob Phillips wrote:
| Presumably you have modified the code? What does it look like now?
| And what Excel version do you have?

Hi Bob, code in module 1 of c:\text.xls is (didn't modify it)
I'm working with Excel2000.
After Dim FSO as Object follws a line, is that correct?

Option Explicit

Dim FSO As Object

Sub ProcessFiles()
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim this As Workbook
Dim cnt As Long

Set FSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
sFolder = "C:\MyTest"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)

Set Files = Folder.Files
cnt = 1
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=file.Path
this.Worksheets.Add.Name = "File" & cnt
With ActiveWorkbook
.Worksheets(1).Range("A1:C100").Copy
Destination:=this.Worksheets("File" & cnt).Range("A1")
.Close
End With
cnt = cnt + 1
End If
Next file

End If ' sFolder <> ""

End Sub
 
B

Bob Phillips

Adri,

The line after Dim FSO is just for readability, it does nolthing and affects
nothing. I wonder if it is just wrap-around.

Try this version

Dim FSO As Object

Sub ProcessFiles()
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim this As Workbook
Dim cnt As Long

Set FSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
sFolder = "C:\MyTest"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)

Set Files = Folder.Files
cnt = 1
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=file.Path
this.Worksheets.Add.Name = "File" & cnt
With ActiveWorkbook
.Worksheets(1).Range("A1:C100").Copy _
Destination:=this.Worksheets("File" & cnt).Range("A1")
.Close
End With
cnt = cnt + 1
End If
Next file

End If ' sFolder <> ""

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
A

Adri

Bob, the last version does not work either.

Bob Phillips wrote:
| Adri,
|
| The line after Dim FSO is just for readability, it does nolthing and
| affects nothing. I wonder if it is just wrap-around.
|
| Try this version
|
| Dim FSO As Object
|
| Sub ProcessFiles()
| Dim i As Long
| Dim sFolder As String
| Dim fldr As Object
| Dim Folder As Object
| Dim file As Object
| Dim Files As Object
| Dim this As Workbook
| Dim cnt As Long
|
| Set FSO = CreateObject("Scripting.FileSystemObject")
|
| Set this = ActiveWorkbook
| sFolder = "C:\MyTest"
| If sFolder <> "" Then
| Set Folder = FSO.GetFolder(sFolder)
|
| Set Files = Folder.Files
| cnt = 1
| For Each file In Files
| If file.Type = "Microsoft Excel Worksheet" Then
| Workbooks.Open Filename:=file.Path
| this.Worksheets.Add.Name = "File" & cnt
| With ActiveWorkbook
| .Worksheets(1).Range("A1:C100").Copy _
| Destination:=this.Worksheets("File" & cnt).Range("A1")
| .Close
| End With
| cnt = cnt + 1
| End If
| Next file
|
| End If ' sFolder <> ""
|
| End Sub
|
|
|
| || Bob Phillips wrote:
||| Presumably you have modified the code? What does it look like now?
||| And what Excel version do you have?
||
|| Hi Bob, code in module 1 of c:\text.xls is (didn't modify it)
|| I'm working with Excel2000.
|| After Dim FSO as Object follws a line, is that correct?
||
|| Option Explicit
||
|| Dim FSO As Object
||
|| Sub ProcessFiles()
|| Dim i As Long
|| Dim sFolder As String
|| Dim fldr As Object
|| Dim Folder As Object
|| Dim file As Object
|| Dim Files As Object
|| Dim this As Workbook
|| Dim cnt As Long
||
|| Set FSO = CreateObject("Scripting.FileSystemObject")
||
|| Set this = ActiveWorkbook
|| sFolder = "C:\MyTest"
|| If sFolder <> "" Then
|| Set Folder = FSO.GetFolder(sFolder)
||
|| Set Files = Folder.Files
|| cnt = 1
|| For Each file In Files
|| If file.Type = "Microsoft Excel Worksheet" Then
|| Workbooks.Open Filename:=file.Path
|| this.Worksheets.Add.Name = "File" & cnt
|| With ActiveWorkbook
|| .Worksheets(1).Range("A1:C100").Copy
|| Destination:=this.Worksheets("File" & cnt).Range("A1")
|| .Close
|| End With
|| cnt = cnt + 1
|| End If
|| Next file
||
|| End If ' sFolder <> ""
||
|| End Sub
 
A

Adri

I try and try, but nothing really happens. I have a Excel2000 Dutch version.
Any solutions??
Adri
Tom Ogilvy wrote:
| I recreated the environment you describe and ran the code. It ran
| fine for me.
|
|
| || Bob, the last version does not work either.
||
|| Bob Phillips wrote:
||| Adri,
|||
||| The line after Dim FSO is just for readability, it does nolthing and
||| affects nothing. I wonder if it is just wrap-around.
|||
||| Try this version
|||
||| Dim FSO As Object
|||
||| Sub ProcessFiles()
||| Dim i As Long
||| Dim sFolder As String
||| Dim fldr As Object
||| Dim Folder As Object
||| Dim file As Object
||| Dim Files As Object
||| Dim this As Workbook
||| Dim cnt As Long
|||
||| Set FSO = CreateObject("Scripting.FileSystemObject")
|||
||| Set this = ActiveWorkbook
||| sFolder = "C:\MyTest"
||| If sFolder <> "" Then
||| Set Folder = FSO.GetFolder(sFolder)
|||
||| Set Files = Folder.Files
||| cnt = 1
||| For Each file In Files
||| If file.Type = "Microsoft Excel Worksheet" Then
||| Workbooks.Open Filename:=file.Path
||| this.Worksheets.Add.Name = "File" & cnt
||| With ActiveWorkbook
||| .Worksheets(1).Range("A1:C100").Copy _
||| Destination:=this.Worksheets("File" & cnt).Range("A1")
||| .Close
||| End With
||| cnt = cnt + 1
||| End If
||| Next file
|||
||| End If ' sFolder <> ""
|||
||| End Sub
|||
|||
|||
||| |||| Bob Phillips wrote:
||||| Presumably you have modified the code? What does it look like now?
||||| And what Excel version do you have?
||||
|||| Hi Bob, code in module 1 of c:\text.xls is (didn't modify it)
|||| I'm working with Excel2000.
|||| After Dim FSO as Object follws a line, is that correct?
||||
|||| Option Explicit
||||
|||| Dim FSO As Object
||||
|||| Sub ProcessFiles()
|||| Dim i As Long
|||| Dim sFolder As String
|||| Dim fldr As Object
|||| Dim Folder As Object
|||| Dim file As Object
|||| Dim Files As Object
|||| Dim this As Workbook
|||| Dim cnt As Long
||||
|||| Set FSO = CreateObject("Scripting.FileSystemObject")
||||
|||| Set this = ActiveWorkbook
|||| sFolder = "C:\MyTest"
|||| If sFolder <> "" Then
|||| Set Folder = FSO.GetFolder(sFolder)
||||
|||| Set Files = Folder.Files
|||| cnt = 1
|||| For Each file In Files
|||| If file.Type = "Microsoft Excel Worksheet" Then
|||| Workbooks.Open Filename:=file.Path
|||| this.Worksheets.Add.Name = "File" & cnt
|||| With ActiveWorkbook
|||| .Worksheets(1).Range("A1:C100").Copy
|||| Destination:=this.Worksheets("File" & cnt).Range("A1")
|||| .Close
|||| End With
|||| cnt = cnt + 1
|||| End If
|||| Next file
||||
|||| End If ' sFolder <> ""
||||
|||| End Sub
 
B

Bob Phillips

?addition

It's in each version of code I posted.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
A

Adri

I also asked the question in the Dutch newsgroup. There someone came up with
the solution.
In the Dutche verion of Excel file the Type = "Microsoft Excel Worksheet"
must be changed Type = "Microsoft Excel-werkblad".
Now it runs fine. Thank you all.
Adri


Bob Phillips wrote:
| ?addition
|
| It's in each version of code I posted.
|
|
| || Adri,
||
||
|| with the addition of 'dim fso as object' is runs fine for me too.
||
|| see my elaborate answer to your multipost in nl.office.excel
||
||
|| keepITcool
||
|| < email : keepitcool chello nl (with @ and .) >
|| < homepage: http://members.chello.nl/keepitcool >
||
||
||
||| I recreated the environment you describe and ran the code. It ran
||| fine for me.
 
T

Tom Ogilvy

That sounds like an excellent reason not to use the scripting runtime to do
this unless it is just for your personal use.
 
Top