CODEWITHSUNDEEP
excelcopy-pastevba
JordanCA57
JordanCA57

Reputation: 125

Excel VBA copy data from one workbook to another workbook

I have a workbook that has four worksheets with data in each. I need to open another workbook and copy from there into each of the original files worksheets.

The data is setup as tables so I need to leave the first row headers in place.

This is what I'm using now (see below), but I read that there is a better way to do it with something like this.

Workbooks("File1.xls").Sheets("Sheet1").range("A1").Copy Workbooks("File2.xls").Sheets("Sheet2").range("A1")

The problem I have is I don't know how to copy everything except the first row. With the code I'm currently using I recorded a macro that goes to cell A2 and uses CMD+SHF+END to grab all the data.

Thanks in advance for any help you can give me.

Sub UpdateData()
'
' UpdateData Macro
Application.ScreenUpdating = False
' Clear current data.
    Sheets("ClientInfo").Select
    Rows("2:" & Rows.Count).ClearContents
    Sheets("Quotes").Select
    Rows("2:" & Rows.Count).ClearContents
    Sheets("PolicyPlanData").Select
    Rows("2:" & Rows.Count).ClearContents
    Sheets("EstimatedPremium").Select
    Rows("2:" & Rows.Count).ClearContents

'Open Data file.
    Workbooks.Open Filename:= _
        "W:\My File Cabinet\cndjrdn\BGA\ClientBio\ClientData.xls"
'Copy data into each worksheet.
Application.CutCopyMode = False
     Windows("ClientData.xls").Activate
        Application.GoTo Sheets("ClientInfo").Range("A2")
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
    Windows("BGA Client Bio May2016v4.xlsx.xlsm").Activate
        Application.GoTo Sheets("ClientInfo").Range("A2")
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("A2").Select
    Windows("ClientData.xls").Activate
        Application.GoTo Sheets("Quotes").Range("A2")
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
    Windows("BGA Client Bio May2016v4.xlsx.xlsm").Activate
        Application.GoTo Sheets("Quotes").Range("A2")
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("A2").Select
    Windows("ClientData.xls").Activate
        Application.GoTo Sheets("PolicyPlanData").Range("A2")
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
    Windows("BGA Client Bio May2016v4.xlsx.xlsm").Activate
        Application.GoTo Sheets("PolicyPlanData").Range("A2")
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("A2").Select
    Windows("ClientData.xls").Activate
        Application.GoTo Sheets("EstimatedPremium").Range("A2")
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
    Windows("BGA Client Bio May2016v4.xlsx.xlsm").Activate
        Application.GoTo Sheets("EstimatedPremium").Range("A2")
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("A2").Select
'Refresh PivotTable(s)
    ThisWorkbook.RefreshAll
'Close Data File
    Windows("ClientData.xls").Activate
        ActiveWorkbook.Close SaveChanges:=False

End Sub

Upvotes: 0

Views: 5046

Answers (1)

Joe Messingschlager
Joe Messingschlager

Reputation: 11

Try using named ranges for the tables that you want to duplicate. Dynamic named ranges allow the range to automatically resize if you table changes width or length. Drop named ranges into Excel Arrays and then drop the array into the new location. It's much faster than copy and paste and it allows you to do all the copies without needing to switch back and forth between the worksheets. Working in arrays for manipulating data and making calculations is much faster than using the cells of the spreadsheet to do the same.

As another advisor said, get rid of the .selects for worksheets and ranges. To clear a range, just use something like:

Range("A1:Y240").ClearContents

Or to do this with an table of unknown width and height starting at A1:

Sheets("ClientInfo").Range("A1").Resize(Cells(Rows.Count, "A").End(xlUp).Row, Cells(1, columns.Count).End(xlToLeft).Column).ClearContents

The only requirement is that the Column A and Row 1 have no blanks from beginning to end.

Upvotes: 0

Related Questions