Macro para copiar datos de un libro a otro utilizando Matrices

El uso de matrices es de las mejores prácticas para realizar los procesos en memoria con una gran cantidad de datos.

En este ejemplo, la macro copia los datos de las columnas del libro 1 y las pega en el libro 2, pero en el libro 2 las columnas están en diferente orden.

En el vídeo también explico la manera de utilizar el diccionario (Dictionary) para indexar los títulos de las columnas. 

Código para copiar Datos:

---

Sub Comparar_Datos()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, lr As Long, lc As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set sh1 = Workbooks("Libro1").Sheets("Matriz")
  Set sh2 = Workbooks("Libro2").Sheets("Datos")
  
  lr = sh1.Range("A:D").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  lc = sh1.Cells(4, Columns.Count).End(1).Column
  a = sh1.Range("A4", sh1.Cells(lr, lc)).Value
  b = sh2.Range("A4").Resize(UBound(a, 1), UBound(a, 2)).Value
    
  'recorre las columnas del libro2 para armar el diccionario
  For j = 1 To UBound(b, 2)
    dic(b(1, j)) = j  'almacena el título en el diccionario y como item la columna
  Next
  
  'recorre la matriz 'a' por columna, busca la columna en el diccionario
  'y en esa columna almacena los datos
  For j = 1 To UBound(a, 2)
    If dic.exists(a(1, j)) Then
      'pasa los datos de la matriz 'a' a la matriz 'b'
      For i = 2 To UBound(a, 1)
        b(i, dic(a(1, j))) = a(i, j)
  
        'sh2.Range("A4").Resize(UBound(b, 1), UBound(b, 2)).Value = b
      
      Next
    End If
  Next
    
  sh2.Range("A4").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

---

Macro para copiar en 2 columnas diferentes en el destino:

---

Sub Comparar_Datos_2()

'copiar en dos columnas diferentes

  Dim sh1 As Worksheet, sh2 As Worksheet

  Dim dic As Object

  Dim a As Variant, b As Variant

  Dim i As Long, j As Long, lr As Long, lc As Long

  Dim js As String, col As Variant

  

  Set dic = CreateObject("Scripting.Dictionary")

  Set sh1 = Workbooks("Libro1").Sheets("Matriz")

  Set sh2 = Workbooks("Libro2").Sheets("Datos")

  

  lr = sh1.Range("A:D").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row

  lc = sh1.Cells(4, Columns.Count).End(1).Column

  a = sh1.Range("A4", sh1.Cells(lr, lc)).Value

  

  lc = sh2.Cells(4, Columns.Count).End(1).Column      'columnas en libro2

  b = sh2.Range("A4").Resize(UBound(a, 1), lc).Value

    

  'recorre las columnas del libro2 para armar el diccionario

  For j = 1 To UBound(b, 2)

    If Not dic.exists(b(1, j)) Then

      dic(b(1, j)) = j  'almacena el título en el diccionario y como item la columna

    Else

      js = dic(b(1, j)) & "|" & j

      dic(b(1, j)) = js 'almacena otra columna en caso de repetirse el mismo título

    End If

  Next

  

  'recorre la matriz 'a' por columna, busca la columna en el diccionario

  'y en esa columna almacena los datos

  For j = 1 To UBound(a, 2)

    If dic.exists(a(1, j)) Then

      'pasa los datos de la matriz 'a' a la matriz 'b'

      For Each col In Split(dic(a(1, j)), "|")    'para cada columna, incluso si hay repetidas

        For i = 2 To UBound(a, 1)

          b(i, col) = a(i, j)

        Next

      Next

    End If

  Next

    

  sh2.Range("A4").Resize(UBound(b, 1), UBound(b, 2)).Value = b

End Sub

---

Archivo: