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

1 Respuesta

Respuesta
2

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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas