Copy Data Between Excel Sheets using VBA



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


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

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 then 1 (see picture below).

Smiley face

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. Do not forget to read my comments. 😉

Sub CopyData1()
Dim oConn As ADODB.Connection, oRst As ADODB.Recordset
Dim sConn As String, sSql As String

On Error GoTo Err_CopyData1

sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0 Macro;HDR=YES';"

Set oConn = New ADODB.Connection
With oConn
 .ConnectionString = sConn
End With

sSql = "SELECT [Part_Number], [Name], [Version], [Level]" & vbCr & _
 "FROM [Sheet1$A1:D100]" & vbCr & _
 "WHERE [Level]>1;"

Set oRst = New ADODB.Recordset
oRst.Open sSql, oConn, adOpenStatic, adLockReadOnly

With ThisWorkbook.Worksheets("Sheet2")
 .Range("A2:D10000").Delete xlShiftUp
 .Range("A2").CopyFromRecordset oRst
End With

 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

 MsgBox Err.Description, vbExclamation, Err.Number
 Resume Exit_CopyData1
End Sub

For further details, please see:

Solution #2 – using Do/While..Loop or For...Next loop

A brief description of how to use the article or code. The class names, the methods and properties, any tricks or tips.

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

On Error GoTo Err_CopyData2

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


i = 2
j = 2

Do While srcWsh.Range("A" & i) <> ""
 If srcWsh.Range("D" & i) = 1 Then GoTo SkipThisRow
 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
 j = j + 1

 i = i + 1

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

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

Final note

I hope you’ve learned how to copy data between sheets in the same workbook.


2017-05-17 – first, initial version