Copiar datos entre hojas de Excel utilizando VBA

La mayoría de los novatos en esto de la programación en VBA cometen errores, que solemos llamar comúnmente como malas prácticas. ¿Cuáles son las principales malas prácticas en Excel-VBA bajo mi punto de vista?

• Utilizar código sin contexto, como por ejemplo:

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

Imagina que deseas insertar estos valores en Sheet2, pero cuando se ha ejecutado el código, Sheet1 estaba activo. ¿Dónde se han escrito los datos? Por supuesto, en Sheet1.

• Utilizar los métodos Select y Activate. Esta suele ser la razón de varios problemas, tales como cálculos innecesarios.
• Utilizar variables indefinidas (no declaradas explícitamente como otro tipo). En ese caso, cada variable consume más memoria de la necesaria, debido al tipo de variante.
• Código sin manipulación de errores

Para obtener más información, consulta: Excel VBA Performance Coding Best Practices.

Digamos que deseas copiar parte de los datos de Sheet1 en Sheet2. La condicion es: Level debe ser mayor que 1 (ver imagen de abajo).

Método 1. Utilizar ADODB. Recordset y Range.CopyFormRecordset

Este método es realmente sencillo. Importante, antes de ejecutar el código de abajo, tienes que insertar la referencia a Microsoft ActiveX Data Object Library x.x.

'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

En caso de que desees obtener datos de otro workbook o desees consultar una versión anterior de los archivos de MS Excel, tendrás que cambiar el string de conexión. Si deseas saber cómo copiar datos en hojas nuevas o existentes en un workbook diferente, echa un vistazo al siguiente método.

Método 2: Utilizando Do/While y For...Next

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

¿Por qué un conjunto de columnas han sido codificadas en el anterior ejemplo? La respuesta es bastante fácil. Es posible que desees copiar los datos en un orden distinto o en un rango diferente.

Método 3: Utilizando FilterAndCopy

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

Fuente: Maciej Los

Guardar