Macro to copy range from Excel files in folder

N

nc

Hi

I am using Excel 2003

I would like to use macro to do the following.

I have a few Excel files in a folder and I would like to copy the same range
from each file, and paste it in a specific workbook/template.

Please help.
 
B

Bob Phillips

Sub ProcessFiles()
Dim oThis As Worksheet
Dim oFSO As Object
Dim oFiles As Object
Dim oFile As Object
Dim sFolder As String
Dim oFolder As Object
Dim i As Long

Application.ScreenUpdating = False

Set oThis = ActiveSheet
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\MyTest"

If sFolder <> "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
i = i + 1
Workbooks.Open Filename:=oFile.Path
With ActiveWorkbook
oThis.Cells(i, "A").Value =
..ActiveSheet.Range("A1").Value
.Close savechanges:=False
End With
End If
Next oFile
End If ' sFolder <> ""

Application.ScreenUpdating = True

End Sub
 
Top