Segue meu arquivo do Excel para facilitar a compreensão.

Veja se é o que espera

Sub PesquiMesa()
'Declaraçao das Variaveis
Dim Procurar, Achei
Dim EndPrimeiroItem
Dim Localizado

Procurar = InputBox("Digite a mesa a ser localizada...", "Localizar Mesa")
If Procurar = "" Then Exit Sub

Application.ScreenUpdating = False
Achei = ""
With Sheets("Planilha2").Range("D:D")
        
    ' Carrega a variavel de Objeto Localizado
    Set Localizado = .Find(Procurar, LookIn:=xlValues, LookAt:=xlWhole)
    'Para localizar parte do texto na celula, mudar a propriedade para xlPart
    
    If Not Localizado Is Nothing Then
        EndPrimeiroItem = Localizado.Address  'guarda o endereço da célula do 1º.valor localizado
        
        Do
            Localizado.Select
            If Localizado.Offset(0, -2).Value = "" Then
                Achei = Achei & Chr(10) & "Vazio"
            Else
                Achei = Achei & Chr(10) & Localizado.Offset(0, -2).Value
            End If
            Set Localizado = .FindNext(Localizado)  'Segue a procura
        Loop While Not Localizado Is Nothing And Localizado.Address <> EndPrimeiroItem
    MsgBox "Mesa " & Localizado & ": " & Achei
    End If
End With
End Sub

Reinaldo, muito obrigado pela resposta, a principio tudo corre bem, mas na linha Localizado.Select, aparece: O método select da classe Range falhou.
Desde já agradeço.

Gionani, a principio, o erro se dá porque não temos a "Planilha2" em foco, ou seja selecionada, se rodar a rotina com a aba "Planilha2" ativa verá que não da erro.

Pelo que entendi, você até pode eliminar esta linha, uma vez que temos a instrução "Application.ScreenUpdating = False", que congela a tela, e ela impede que se navegue até esta aba, então o "Select" não teria efeito, mas, se não quiser eliminar a Instrução troque-a pela a abaixo :

Range(Localizado.Address).Select

[]s

Realmente, foi só excluir a linha. Muito grato pela ajuda de vocês, foi muito valiosa.
Ótima semana e boas Festas!!