Sub Sample1()

    keyWord = "テスト"          '検索ワード
    Set Rng = Range("A1:E10")   '検索範囲

    '部分一致：xlPart
    '完全一致：xlWhole
    Set obj = Rng.Find(keyWord, LookAt:=xlPart)

    '検索結果判定
    If obj Is Nothing Then
        MsgBox keyWord & "は見つかりません"
    Else
        '1つ目の位置を記憶
        t_Row = obj.Row
        t_Column = obj.Column
        Count = 1
        Do
            Cells(Count, 6) = obj.Row       'Y
            Cells(Count, 7) = obj.Column    'X
            Cells(Count, 8) = obj.Value     'セルの内容
            Count = Count + 1

            '次の検索結果へ
            Set obj = Rng.FindNext(obj)
        '同じ箇所に戻るまでループ
        Loop While t_Row <> obj.Row And t_Column <> obj.Column
    End If

End Sub