リストから別シートの別の列の値を検索して抽出したい

Sub 一致検索()

    Dim i As Long '店舗一覧の行数のカウントアップ用
    Dim j As Long '転記先の行数のカウントアップ用
    Dim k As Long
    Dim rw As Long '最終行取得用
    
    Sheets("店舗一覧").Activate
    rw = Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets("店舗ID").Activate
    rx = Cells(Rows.Count, 1).End(xlUp).Row
    
    j = 4 '初期設定
    k = 4
    l = 2
    
    For l = 2 To rx
        Worksheets("店舗ID").Range("A" & l).Copy Destination:=Range("E" & k)
    For i = 2 To rw
        If Sheets("店舗一覧").Cells(i, 1) = Worksheets("店舗ID").Range("E" & k) Then
            With Sheets("店舗ID")
                .Cells(j, 6) = Sheets("店舗一覧").Cells(i, 3)
                j = j + 1
            End With
        End If
    Next i
            k = j
    Debug.Print k
    Next l
End Sub

店舗一覧シート

店舗ID