Copying Ranges between Workbooks

Hi,

I am copying a specified set of data from one workbook to another. I am using ranges to do this but the code seems to be quite cumbersome and inefficient. See code below:


FileSpec = IndRetPremFiles

Set fs = New FileSystemObject
Set folder = fs.GetFolder(FileSpec)

intFileCount = folder.Files.Count
Set XL = New Excel.Application
Set WB1 = XL.Workbooks.Open(NewFilePath & "Master\IndependentRetPremMaster.xls")
Set WS1 = WB1.Worksheets(1)
'WB1.Activate

PrgCount = 0
ProgBar.Max = intFileCount
Do
For Each file In folder.Files

FName = file.Name
FilePos = InStr(1, FName, ".", vbTextCompare) - 1
FileExt = Mid(FName, FilePos + 1, FilePos)
NewFile = Mid(FName, 1, FilePos)
FileRead = FileSpec & FName

Set WB = XL.Workbooks.Open(FileRead)
Set WS = WB.Worksheets(1)


Do While ActiveCell.Offset(0, 1) <> ""
ActiveCell.Offset(1, 0).Select
Loop

CurrRow = ActiveCell.Row

Range("A2:A" & CurrRow - 1).Select
Selection.Copy

WB1.Activate
ActiveSheet.Paste

WB.Activate
Range("B2:B" & CurrRow - 1).Select
Selection.Copy

WB1.Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Paste

WB.Activate
Range("C2:C" & CurrRow - 1).Select
Selection.Copy

WB1.Activate
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste

WB.Activate
Range("D2:D" & CurrRow - 1).Select
Selection.Copy

WB1.Activate
ActiveCell.Offset(0, 18).Select
ActiveSheet.Paste

WB.Activate
Range("E2:E" & CurrRow - 1).Select
Selection.Copy

WB1.Activate
ActiveCell.Offset(0, -11).Select
ActiveSheet.Paste


As you can see range object is used back and forth - i was wondering if there was a more efficient way of doing this

Chet

perhaps you can try this

destinationfile.xls.sheet("destination").range("destination").value = sourcefile.xls.sheet("source").range("source").value


or you combine some of your ranges

Range("A2: D" & CurrRow - 1).Select
Selection.Copy

WB1.Activate
ActiveSheet.Paste

copy not every single row but i.e. 4 rows "A: D"

Or do

Range("A2: D" & CurrRow - 1).Copy

in stead of

Range("A2: D" & CurrRow - 1).Select
Selection.Copy

Try to use as less possible "Select"