Ayuda con este codigo

Private Sub cmdBuscar_Click()
Dim rng As Range, msg As String
        With Columns("A:A")
        Set rng = .find( _
        What:=InputBox("Nombre Completo del Cliente a Buscar: ", "SERVICIOS 2008"), _
        After:=.Cells(1), _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext)
        End With
      On Error Resume Next
      Error 2023
      If Err = 2023 Then
      End If
     If Not rng Is Nothing Then
        With rng
        If rng = 0 Then
        MsgBox ("No hay nombre que buscar:")
        ActiveCell.Columns = 1
        Else
            msg = msg & "Nombre: " & .Value
            msg = msg & "Folio: " & .Offset(, 1).Value
            MsgBox msg
        End If
            ActiveCell.Columns = .Offset(, 1).Value
        End With
        Else
        MsgBox ("No hay registro, consulte al administrador.....")
        End If
End Sub
busco: juan perez m
este codigo muestra: ejemplo: nombre: juan perez martinez  folio: 45
pero kiero que aga esto:
juan perez martinez  folio 45
juan perez marcel     folio 50
juan perez montalvo  folio 145
juan perez mirto   folio 179
ok espero su repsuesta gracias