Sub 各シート調整()
'シート番号変数宣言
Dim シート番号 As Long
'3枚目のシートから最終シートまで同じ処理
For シート番号 = 4 To Worksheets.Count
'メールアドレス転記
Worksheets(シート番号).Range("A3") = Worksheets(シート番号).Range("D6")
'メールアドレス列削除
Worksheets(シート番号).Range("D:D").Delete
'列幅調整
Worksheets(シート番号).Columns("A:C").AutoFit
Next シート番号
End Sub
