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

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)

"Adri" wrote in message
...
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

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
|
|
| "Adri" wrote in message
| ...
|| 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

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)

"Adri" wrote in message
...
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
|
|
| "Adri" wrote in message
| ...
|| 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

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

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)

"Adri" wrote in message
...
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