Macro que busque código y copiar Información
Señores expertos, tengo un código del foro el cual no me funciona tengo un libro con hoja y hoja 2 y una tercera llamada código, quiero que la macro busque los códigos si los encuentra en la hoja 1 extraiga todas las columnas relacionas en la hoja 2 y cada ves que incluya un nuevo código en la hoja coligo ella lo identifique y lo pueda traer de la hoja 1 a la hoja 2
Adjunto imagen y el código el cual no me funciona
Sub buscardatos()
Application.ScreenUpdating = False
On Error Resume Next
DisplayAlerts = False
Dim uf As String
Dim conta As Integer
f = 2
f1 = 2
f2 = 2
Sheets("hoja2").Cells.Clear
Sheets("hoja1").Range("b" & 1 & ":m" & 1).Copy Destination:=Sheets("hoja2").Range("a" & 1)
Sheets("hoja1").Select
Cells(f, 1).Select
While Cells(f, 1) <> Empty
dato = Cells(f, 1)
While Cells(f1, 4) <> Empty
dato1 Cells(f, 1)
If dato = dato1 Then
Sheets("hoja1").Range("b" & f1 & ":m" & f1).Copy Destination:=Sheets("hoja2").Range("a" & f2)
conta = conta + 1
f2 = f2 + 1
End If
f1 = f1 + 1
Wend
fi = 2
f = f + 1
Wend
uf = Sheets("hoja2").Range("c" & Rows.Count).End(xlUp).Row
Sheets("hoja2").Range("c" & 2 & ":e" & uf).NumberFormat = "#,##0.00"
If conta = 0 Then
MsgBox ("No se encontro codigo buscado"), vbInformation, "aviso"
Else
MsgBox ("Se copiaron con exito" & conta & "codigo"), vbInformation, "aviso"
End If
DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Prueba con este código mientras alguien más te da un código más sencillo, importante que los códigos sean exactos para que pueda conseguir el dato.
Prueba y me avisas:
Sub Trasladar_Registros()
Dim CantCod
Dim CantH
Dim CantH2
Dim Cod
Dim Dato
Dim Linea
Sheets("hoja2").Cells.Clear
Sheets("hoja").Select
Rows("1:1").Copy
Range("A2").Select
CantH = Selection.CurrentRegion.Rows.Count
Sheets("hoja2").Select
Range("a1").Select
ActiveSheet.Paste
Sheets("codigos").Select
Range("A2").Select
CantCod = Selection.CurrentRegion.Rows.Count
Linea = 1
For i = 2 To CantCod
Sheets("codigos").Select
Cod = Range("a" & i)
Sheets("hoja").Select
For x = 2 To CantH
Sheets("hoja").Select
If Range("a" & x) = Cod Then
Range("a" & x).Select
Selection.EntireRow.Copy
Sheets("hoja2").Select
Do Until Range("a" & Linea) = ""
Linea = Linea + 1
Loop
Range("a" & Linea).Select
ActiveSheet.Paste
Else
End If
Next
Next
Application.CutCopyMode = False
Sheets("Hoja2").Select
Range("a1").Select
Sheets("Hoja").Select
Range("a1").Select
Sheets("codigos").Select
Range("a1").Select
MsgBox ("Proceso Finalizado")
End Sub
Buen Día
Gregorio
de antemano muchas gracias por tu respuesta, al correr la macro me genera un error 9 de sub indice, valide los nombre de las hojas y el código en varias presenta el nombre de hoja y no especifica que numero de hoja es, creo que es por este motivo que no corre.
quedo atento a tu respuesta.
muchas gracias
Alexander disculpa tienes razón parece que en vez de colocar "Hoja1" coloqué "Hoja" prueba ahora a a ver:
Sub Trasladar_Registros()
Dim CantCod
Dim CantH
Dim CantH2
Dim Cod
Dim Dato
Dim Linea
Sheets("hoja2").Cells.Clear
Sheets("hoja1").Select
Rows("1:1").Copy
Range("A2").Select
CantH = Selection.CurrentRegion.Rows.Count
Sheets("hoja2").Select
Range("a1").Select
ActiveSheet.Paste
Sheets("codigos").Select
Range("A2").Select
CantCod = Selection.CurrentRegion.Rows.Count
Linea = 1
For i = 2 To CantCod
Sheets("codigos").Select
Cod = Range("a" & i)
Sheets("hoja1").Select
For x = 2 To CantH
Sheets("hoja1").Select
If Range("a" & x) = Cod Then
Range("a" & x).Select
Selection.EntireRow.Copy
Sheets("hoja2").Select
Do Until Range("a" & Linea) = ""
Linea = Linea + 1
Loop
Range("a" & Linea).Select
ActiveSheet.Paste
Else
End If
Next
Next
Application.CutCopyMode = False
Sheets("Hoja2").Select
Range("a1").Select
Sheets("Hoja1").Select
Range("a1").Select
Sheets("codigos").Select
Range("a1").Select
MsgBox ("Proceso Finalizado")
End Sub
Es que cuando redactaste habías dicho que se llamaba hoja...
buen día
Gregorio
muchas gracias, la macro corrió perfecto, pero tengo un inconveniente me trae información repetida hay la posibilidad que me ayudes colocando una linea en la macro que tenga en cuanta la columna c "orden", y extraiga solo valores únicos a partir de esta clave.
muchas gracia por tu valiosa ayuda me estas ahorrando mucho tiempo y errores en el proceso
Si en la hoja códigos esta repetido es probable que copie dos veces, del resto no debería, ahora bien aclárame si no entendí bien, porque si tomo como clave la columna orden dejaría por fuera un tipo de trabajo, por ejemplo si tomo sólo el registro Orden 12913, estaría quedando por fuera el trabajo AD020 o el Trabajo AD015.. Atento a tus comentarios
Buen Día
Si, tienes razón, muchas gracias por tu ayuda y por tu tiempo excelente trabajo como te mencione me ahorraste tiempo y errores.
Siempre a la orden.
