Optimizar macro de búsqueda copiado y pegado
Agradezco a quien me pueda ayudar a optimizar esta macro.
Realice la grabación de esta macro tengo datos en la hoja1 de la columna B8 a la columna BX1000
Requiero buscar el dato de la hoja2 de la columna A2 en la hoja1y copiarlo y pegarlo en la hoja2 realizo la operación hasta que encuentra la ultima celda vacía
Esta es la fórmula que grave quiero optimizarla
Sub Macro3()
' Macro3 Macro
ActiveCell.FormulaR1C1 = _
"=ROUND(IF(RC[-3]>0, VLOOKUP(RC[-3], NOMINA!R[6]C[-2]:R[998]C[72], 11,0),""""), 0)"
Range("D2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=ROUND(IF(RC[-4]>0, VLOOKUP(RC[-4], NOMINA!R[6]C[-3]:R[998]C[71], 21,0),""""), 0)"
Range("E2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=ROUND(IF(RC[-5]>0, VLOOKUP(RC[-5], NOMINA!R[6]C[-4]:R[998]C[70], 49,0),""""), 0)"
Range("F2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("G2").Select
End Sub
2 respuestas
Te dejo la macro reducida y comentada.
Sub Macro3()
' Macro3 Macro. Comentada por Elsamatilde
'en celda activa se coloca una fórmula de búsqueda. Asumo que se trata de D2
With Range("D2")
.FormulaR1C1 = _
"=ROUND(IF(RC[-3]>0, VLOOKUP(RC[-3], NOMINA!R[6]C[-2]:R[998]C[72], 11,0),""""), 0)"
'se copia y pega como solo valores en la misma celda
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
'se repite en E2 y F2 el mismo proceso
With Range("E2")
.FormulaR1C1 = _
"=ROUND(IF(RC[-4]>0, VLOOKUP(RC[-4], NOMINA!R[6]C[-3]:R[998]C[71], 21,0),""""), 0)"
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Range("F2")
.FormulaR1C1 = _
"=ROUND(IF(RC[-5]>0, VLOOKUP(RC[-5], NOMINA!R[6]C[-4]:R[998]C[70], 49,0),""""), 0)"
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
Range("G2").Select
End Sub
Te invito a mirar el video N° 11 - Mejoras en el código, en especial a partir del minuto 8:00
Visita:
Cursos de Excel y Macros - YouTube
"Requiero buscar el dato de la hoja2 de la columna A2 en la hoja1y copiarlo y pegarlo en la hoja2 realizo la operación hasta que encuentra la ultima celda vacía"
La siguiente macro lee la "Hoja2" empezando en la celda A2 y hasta la última fila con datos de la columna.
En esta línea de la macro debes poner las columnas que quieres de regreso en la hoja2.
cols = Array("L", "V", "AX")La macro completa:
Sub copiardatos()
'Por Dante Amor
Dim sh1 As Worksheet, sh2 As Worksheet
Dim cols As Variant
Dim f As Range
Dim i As Long, j As Long
'
'aquí van las columnas que quieres de regreso
cols = Array("L", "V", "AX")
'
Set sh1 = Sheets("NOMINA") 'hoja con datos
Set sh2 = Sheets("Hoja2") 'hoja con las fórmulas
'para cada dato de la hoja empezando en la celda A2 y hasta la última fila con datos
For i = 2 To sh2.Range("A" & Rows.Count).End(3).Row
Set f = sh1.Range("B:B").Find(sh2.Range("A" & i).Value, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
For j = 0 To UBound(cols)
sh2.Cells(i, j + 4).Value = WorksheetFunction.Round(sh1.Cells(f.Row, cols(j)).Value, 0)
Next
End If
Next
End SubRecomendaciones si quieres aprender más sobre VBA:
Consejos para desarrollar macros . curso de excel, curso de macros, excel, macros - YouTube
Macros metodo find. Curso de macros - YouTube
Declarar variables en vba excel. Curso de macros. - YouTube
Metodo find vba excel. Curso de macros. - YouTube
---
Sal u dos Dante Amor