Waubain
01-25-2013, 10:22 AM
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
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