Macro buscar dato y pegar
Que tal, antes que nada les envío un saludo.
Tengo un problema estoy tratando de hacer una macro donde busco un valor dentro de una hoja (Clientes) y cuando encuentre el no. De cliente me pase todos sus datos a otra hoja(Format) y en caso de que no exista me envíe un mensaje de que no existe el cliente.
Ya logre hacer la búsqueda y que me copie los datos en la siguiente hoja, pero al hacer, que me envíe un mensaje de que el cliente no existe se me cicla o traba el excel.
ya tengo un poco avanzado el código. Espero me puedan ayudar con mi problema. Adjunto copia del código
Sub Buscar()
Dim idBuscar As String
Dim ws As Worksheet
Dim fila As Integer
Dim Cliente2 As String
fila = 4
Sheets("Format").Select
Application.ScreenUpdating = False
Sheets("Format").Unprotect
Range("B101:F101").Select
Selection.Copy
Range("B25:F25").Select
ActiveSheet.Paste
Range("B104:H104").Select
Selection.Copy
Range("B28:H28").Select
ActiveSheet.Paste
Range("B107:F107").Select
Selection.Copy
Range("B31:F31").Select
ActiveSheet.Paste
If Range("B22") = "" Then
MsgBox "Ingresa 5 dígitos para para realizar la búsqueda", Buttons:=vbOKOnly, Title:="ERROR"
Else
idBuscar = 0
Cliente2 = Range("B22").Value
Sheets("Clientes").Select
ActiveSheet.Unprotect
Range("A4").Select
While ActiveCell.Value <> Cliente2
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = Cliente2 Then
idBuscar = idBuscar + 1
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Select
Sheets("Format").Select
Range("R150").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Clientes").Select
ActiveCell.Offset(-1, 0).Select
End If
Wend
ActiveCell.Offset(1, 0).Select
If idBuscar = 1 Then MsgBox prompt:="Se encontraron los datos del cliente", Buttons:=vbOKOnly, Title:=" CLIENTE ENCONTRADO "
End If
If idBuscar = 0 Then MsgBox prompt:="Cliente no se encontró verifique el código del cliente.", Buttons:=vbOKOnly, Title:=" E R R O R"
Sheets("Format").Select
Range("B22").Select
Range("B22").ClearContents
End Sub
Saludos
Atentamente.
Gilberto Ramírez