Copy range of many files in directory.

  • Thread starter Thread starter CLUPE
  • Start date Start date
C

CLUPE

Hi,

I have a lot of files in a directory (numbers vary over time). I want
to copy the same range in each of the files to a new file.

How do I do that?
 
Use the following code:
Sub readingFiles()
On Error Resume Next
Dim fs As FileSearch
Dim fileStr As String, wb As Workbook, wbNew As
Workbook
Dim r As Long
Set wbNew = Workbooks.Add ' you can use your own
workbook to copy the ranges
Set fs = Application.FileSearch
fs.LookIn = "C:\YourPath" ' You need to set files path
fs.NewSearch
fs.FileType = msoFileTypeExcelWorkbooks
If fs.Execute(SortBy:=msoSortByFileName,
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To fs.FoundFiles.Count
Set wb = Workbooks.Open(fs.FoundFiles(i))
' next you can set the sheet and range you need
wb.Sheets("Rep").Range("A1:D20").Copy
' next you can use the sheet you need
r = wbNew.Sheets("Sheet1").Cells.SpecialCells
(xlLastCell).Row
' next you can use the column you want
wbNew.Activate
wbNew.Sheets("Sheet1").Cells(r + 1, 1).Select
Application.DisplayAlerts = False
wbNew.Sheets("Sheet1").Paste
Application.CutCopyMode = False
wb.Close False
Next i
End If
End Sub


Hope this can be useful

Francisco Mariscal

fcomariscal at hotmail dot com
 
Back
Top