VBAの「検索」ボタン押下で、該当のレコードを取得して一覧表示したい

Question

前提・実現したいこと

VBAの「検索」ボタン押下で、「社員マスタ」シートを検索し、該当のレコードを取得して、「社員情報一覧」シートに一覧表示したいのですが、どのようにコードを書けば良いかわからず、悩んでいます。
以下のように実装したところ、無限ループになってしまいました。
アドバイスをいただけませんでしょうか。
よろしくお願いいたします。

該当のソースコード

Sub Kensaku_Click()

    Dim sht_shain As Worksheet
    Set sht_shain = Worksheets("社員マスタ")
    
    Dim sht_itiran As Worksheet
    Set sht_itiran = Worksheets("社員情報一覧")
    
    Dim FoundCell As Range
    Set FoundCell = sht_shain.Range("A2:O1000").Find(Range("E3").Value)
    
    Dim FirstCell As Range
    
    If FoundCell Is Nothing Then
    
        MsgBox "検索対象が見つかりませんでした。"
        
    Else
        Set FirstCell = FoundCell
        FoundCell.Resize(1, 14).Copy sht_itiran.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
    End If
    Do
        Set FoundCell = Cells.FindNext(FoundCell)
        If FoundCell.Address = FirstCell.Address Then
            Exit Do
        Else
            FoundCell.Resize(1, 14).Copy sht_itiran.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
        End If
    Loop
    
End Sub

試したこと

キーワードを探して、対象が見つからない場合はメッセージを出すように書いてみました。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

よくわかりませんが、こんな感じでどうでしょうか。

Sub Kensaku_Click()

    '社員マスタの桁目
    Const Col_ID = "A"
    Const Col_Name = "B"
    Const Col_Busho = "C"
    Const Col_TelNo = "D"
    Const Col_Mail = "E"
    
    '社員情報格納用
    Dim shainID, shainName, ShainBusho, ShainTelNo, ShainMail
    
    
    Dim sht_shain As Worksheet
    Set sht_shain = Worksheets("社員マスタ")

    Dim sht_itiran As Worksheet
    Set sht_itiran = Worksheets("社員情報一覧")

    Dim c As Range
    Set c = sht_shain.Range("A2:O1000").Find(Range("E3").Value)

    If c Is Nothing Then

        MsgBox "検索対象が見つかりませんでした。"

    Else
       '社員情報取得
        shainID = sht_shain.Cells(c.Row, Col_ID).Value
        shainName = sht_shain.Cells(c.Row, Col_Name).Value
        ShainBusho = sht_shain.Cells(c.Row, Col_Busho).Value
        ShainTelNo = sht_shain.Cells(c.Row, Col_TelNo).Value
        ShainMail = sht_shain.Cells(c.Row, Col_Mail).Value
        
       '社員情報出力
        sht_itiran.Range("E5").Value = shainID
        sht_itiran.Range("E6").Value = shainName
        sht_itiran.Range("E7").Value = ShainBusho
        sht_itiran.Range("E8").Value = ShainTelNo
        sht_itiran.Range("E9").Value = ShainMail
        
    End If


End Sub

Comments

[shogakusha]

ご回答、ありがとうございます。
こちらの方法でも試してみます。

Answer 2

FindNextメソッドを使って次を検索してください。

条件に当てはまるセルを検索する(Find/FindNext/FindPreviousメソッド) ：Excel VBA｜即効テクニック｜Excel VBAを学ぶならmoug

Comments

[shogakusha]

ご回答、ありがとうございます。
上記を参考にFindNextを使用してみましたが、今度は無限ループになってしまいました。
アドバイスをいただけませんでしょうか。