すべて検索する

Findを使ったらFindNextで次々と検索できる。

以前見つかったセルと同じセルが見つかったりしないかだけはチェック必要。

Sub Sample6()
    Dim FoundCell As Range, FirstCell As Range, Target As Range
    Set FoundCell = Cells.Find(What:="田中")
    If FoundCell Is Nothing Then
        MsgBox "見つかりません"
        Exit Sub
    Else
        Set FirstCell = FoundCell
        Set Target = FoundCell
    End If
    Do
        Set FoundCell = Cells.FindNext(FoundCell)
        If FoundCell.Address = FirstCell.Address Then
            Exit Do
        Else
            Set Target = Union(Target, FoundCell)
        End If
    Loop
    Target.Select
    MsgBox Target.Count & "件見つかりました"
End Sub


ネタ元