シート名からメールアドレス検索

Sub シート名からメールアドレス検索()
  
    Dim 行番号, シート番号 As Long
  
        For シート番号 = 4 To Worksheets.Count
    
            For 行番号 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
 
                If Cells(行番号, 1) = Sheets(シート番号).Name Then

                Sheets(シート番号).Range("A1") = Cells(行番号, 2)
     
                End If
 
            Next 行番号
    
    Next シート番号
 
End Sub