More efficient code for copy/paste between workbooks

[Waubain]

Hi, I am new to vba in Excel 2007. I routinely receive a workbook that has the same 9 ordered columns, but the number of rows vary from 100 to >4000. The "to" columns are also consistent but do not match the letter of the source columns. I have been manually transferring the data, but am seeking a better method. Based on internet examples I have gotten this to work, but the code looks clumsy based on what I may write in Access.

Before I repeat the copy and paste rows 7 more times, any thoughts on how to make this more efficient? Thanks in advance for any suggestions on improving any part of the code.


Private Sub cmdCopyWorkbook_Click()
Dim wbs As Workbook 'Source workbook
Dim wbd As Workbook 'Destination workbook already open
Dim ss As Worksheet 'Source worksheet
Dim ds As Worksheet 'Destination worksheet

Application.ScreenUpdating = False

Set wbs = Workbooks.Open("S:\Testing\SourceTest.xls")
Set wbd = Workbooks("DestinationTest.xlsm")
Set ss = wbs.Worksheets("Sheet1")
Set ds = wbd.Worksheets("Sheet1")

ss.Range(ss.Range("A2"), ss.Range("A2").End(xlDown)).Copy
ds.Range(ds.Range("H2"), ds.Range("H2").End(xlUp)(2)).PasteSpecial
ss.Range(ss.Range("B2"), ss.Range("B2").End(xlDown)).Copy
ds.Range(ds.Range("J2"), ds.Range("J2").End(xlUp)(2)).PasteSpecial

wbs.Close False
Set wbs = Nothing
Application.ScreenUpdating = True

End Sub

[Kenneth Hobs]

If column headings match, you can use a Find routine and loop one row of column names.

Otherwise, I would just hard code a two dimensional array and iterate that. Loops are easier to maintain your code.

[Paul_Hossler]

You could also modulaize it



Sub test()
Dim wsFrom As Worksheet, wsTo As Worksheet

Set wsFrom = Workbooks("FromBook.xlsm").Worksheets("sheet1")
Set wsTo = Workbooks("ToBook.xlsx").Worksheets("sheet1")

Call CopyPaste(wsFrom.Range("A:A"), wsTo.Range("C:C"))
Call CopyPaste(wsFrom.Range("E:E"), wsTo.Range("B:B"))
End Sub

Sub CopyPaste(RangeCopy As Range, RangePaste As Range)
Dim r1 As Range, r2 As Range

Set r1 = RangeCopy.Cells(2, 1)
Set r1 = Range(r1, r1.End(xlDown))

Set r2 = RangePaste.Cells(2, 1)
r1.Copy
r2.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = xlCopy

End Sub



The sub could be even more robust if you wanted. For ex, I've used Match accross Row(1) to find the column header so that I knew which column to copy

Paul