Buscar un valor de hoja1 en hoja2 y copiar valores de hoja1 en la fila encontrada en hoja2
Buscar un valor de la hoja1 en la hoja2, en la fila que encuentra este valor copiar valores de hoja1 en la hoja2. Repetir este proceso para un rango de 5 valores, que podrían estar todos de forma consecutiva o separados.
1 Respuesta
Respuesta de Dante Amor
2
¡Gracias!
Los valores en hoja1 están desde F8 hasta F12 y los debo buscar en la hoja2 en la columna C. los valores a copiar en hoja1 están en desde G hasta U y pegarlos en hoja2 a partir de la columna DH hasta DV. La hoja dos tiene 21403 filas y 126 columnas.
Muchas gracias por responder y por su ayuda de antemano
Prueba la siguiente macro:
Sub CopiarDatos()
Dim c As Range, f As Range
Application.ScreenUpdating = False
For Each c In Sheets("Hoja1").Range("F8:F12")
Set f = Sheets("Hoja2").Range("C:C").Find(c.Value, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
Sheets("Hoja1").Range("G" & c.Row & ":U" & c.Row).Copy
Sheets("Hoja2").Range("DH" & f.Row).PasteSpecial xlPasteValues
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
¡Gracias!
Muchas gracias, te lo agradezco, si funciona pero el proceso es extremadamente lento
¿Cuántos registros tienes en la hoja1?
Prueba con la siguiente:
Sub CopiarDatos2()
Dim a As Variant, b As Variant, c As Variant
Dim i As Long, j As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Dim dic As Object
'
Set sh1 = Sheets("Hoja1")
Set sh2 = Sheets("Hoja2")
Set dic = CreateObject("Scripting.Dictionary")
a = sh1.Range("F8:U" & sh1.Range("F" & Rows.Count).End(3).Row).Value
b = sh2.Range("C1:C" & sh2.Range("C" & Rows.Count).End(3).Row).Value
c = sh2.Range("DH1").Resize(UBound(b, 1), UBound(a, 2))
'
For i = 1 To UBound(b, 1)
dic(b(i, 1)) = i
Next
'
For i = 1 To UBound(a, 1)
If dic.exists(a(i, 1)) Then
For j = 2 To UBound(a, 2)
c(dic(a(i, 1)), j - 1) = a(i, j)
Next
End If
Next
'
Sh2. Range("DH1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
