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