View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default Copy several range from all files in folder into several worksheets

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