Copy Data Between Excel Sheets using VBA

Introduction

This tip shows 2 ways to copy data between Excel sheets in the same workbook using VBA.

Background

Most beginners in VBA programming make several mistakes, which are commonly named: bad practice. What is bad practice in Excel-VBA from my point of view?

• Using code without context, for example:

  Range("A1") = "Some Text"
  'or
  Cells(5,5) = 125

  Imagine, you wanted to insert those values into Sheet2, but when a code has been executed, Sheet1 was active. Where the data has been written? Of course, into Sheet1.

• Using Select and Activate method

  This might be the reason for several issues, such as unnecessary calculations.

• Using undefined variables (not explicitly declared as some other type)

  In that case, every variable consumes more memory than is necessary, because of type of variant.
  See Data types

• Using code without error handling

For further details, please see: Excel VBA Performance Coding Best Practices

Let's say you want to copy some portion of data from Sheet1 into Sheet2. A condition is defined as: Level has to be greater than 1 (see image below).

Using the code

Solution #1 - Using ADODB.Recordset and Range.CopyFromRecordset Method

This method is really quick!

Note: Before you run below code, you have to add a reference to Microsoft ActiveX Data Object Library x.x. How? Check or Add an Object Library Reference

Please, check out below code (Excel 2007 ad higher). Do not forget to read my comments. ;)

'needs reference to Microsoft ActiveX Data Object Library x.x
Sub CopyData1()
Dim oConn As ADODB.Connection, oRst As ADODB.Recordset
Dim sConn As String, sSql As String

On Error GoTo Err_CopyData1

'define connection string to itself (this workbook)
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;_
Data Source=" & ThisWorkbook.FullName & ";_
         Extended Properties='Excel 12.0 Macro;HDR=YES';"
'create and open connection
Set oConn = New ADODB.Connection
With oConn
    .ConnectionString = sConn
    .Open
End With
'define query
sSql = "SELECT [Part_Number], [Name], [Version], [Level]" & vbCr & _
    "FROM [Sheet1$A1:D100]" & vbCr & _
    "WHERE [Level]>1;"
'create and open recordset
Set oRst = New ADODB.Recordset
oRst.Open sSql, oConn, adOpenStatic, adLockReadOnly

'context!!!
With ThisWorkbook.Worksheets("Sheet2")
    'clear precious data
    .Range("A2:D10000").Delete xlShiftUp
    'insert filtered data
    .Range("A2").CopyFromRecordset oRst
End With

'exit subroutine
Exit_CopyData1:
    'ignore errors and clean up
    On Error Resume Next
    If Not oConn Is Nothing Then oConn.Close
    Set oConn = Nothing
    If Not oRst Is Nothing Then oRst.Close
    Set oRst = Nothing
    Exit Sub

'error handler
Err_CopyData1:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CopyData1
End Sub

For further details, please see:

• ADODB.Recordset
• Range.CopyFromRecordset

In case you want to fetch data from another type of workbook or you want to refer to earlier version of MS Excel files, you have to change connection string. See: Excel - OleDb 12.0 connection strings

If you would like to know, how to copy data into new or existing Sheet in different workbook, please find related content below.

Solution #2 - Using Do/While..Loop or For...Next Loop

Sub CopyData2()
Dim srcWsh As Worksheet, dstWsh As Worksheet
Dim i As Integer, j As Integer

On Error GoTo Err_CopyData2

'define context
Set srcWsh = ThisWorkbook.Worksheets("Sheet1")
Set dstWsh = ThisWorkbook.Worksheets("Sheet2")

'clear range before you start copying
dstWsh.Range("A2:D10000").Clear

'starting rows
i = 2
j = 2
'loop though the data
Do While srcWsh.Range("A" & i) <> ""
    'go to skip soubroutine if Level is equal to 1
    If srcWsh.Range("D" & i) = 1 Then GoTo SkipThisRow
    'copy set of columns - in this case A to D, but it might be: A, C, E, G
    With dstWsh
        .Range("A" & j) = srcWsh.Range("A" & i)
        .Range("B" & j) = srcWsh.Range("B" & i)
        .Range("C" & j) = srcWsh.Range("C" & i)
        .Range("D" & j) = srcWsh.Range("D" & i)
    End With
    'increase row number in Sheet2
    j = j + 1
'skip subroutine
SkipThisRow:
    'increase row number in Sheet1
    i = i + 1
Loop

Exit_CopyData2:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Exit Sub

Err_CopyData2:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CopyData2
End Sub

You may want to ask me: Why a set of columns has been hard-coded in above example?

The answer is pretty easy. You may want to copy data in defferent order or into different range.

Other solutions

Using Filter-And-Copy

Sub FilterAndCopy()
    Dim srcWsh As Worksheet
    Dim dstWsh As Worksheet
    
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
    
    On Error GoTo Err_FilterAndCopy
    
    'clear the destination range
    dstWsh.Range("A2:A10000").Clear  
    'filter and copy data
    With srcWsh
        .Range("A1").AutoFilter  ' turn on filter
        .UsedRange.AutoFilter Field:=4, Criteria1:=">1"
        'paste data into destination worksheet
        .UsedRange.Copy Destination:=dstWsh.Range("A2")
    End With
    'turn of CutCopyMode and filter
    Application.CutCopyMode = False
    srcWsh.Range("A1").AutoFilter  
 
Exit_FilterAndCopy:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Exit Sub

Err_FilterAndCopy:
    MsgBox Err.Description, vbCritical, Err.Number
    Resume Exit_FilterAndCopy
End Sub

Above method is pretty good, but has several limitations. The main issue is copying a large portion of data. When you copy simple data (no formulas), it can take a while for the operation to complete. But when you're copying the data containing set of formulas, then the time needed to complete operation may increase several times due an Excel have to perform thousands of calculations...

Copy data into new worksheet/workbook or into existing sheet in different workbook

This is quite easy. Depending on situation (workbook is already open or not), you have to change only one line or few lines.

'#1
'workbook is already opened
Set dstWsh = Workbooks("ShortNameOfWorkbook.xlsx").WorkSheets("DestinationSheet")

'#2
'need to open workbook (a path to the file is known)
Workbooks.Open "FullPathAndNameOfWorkbook.xlsx"
Set dstWsh = ActiveWorkbook.Worksheets("DestinationSheet")

Final Note

I hope you've learned how to copy data between sheets and workbooks.

History

• 2017-05-23 - Added: other solutions and information about copying data into new or existing workbook/worksheet
• 2017-05-17 - Initial version