필터를 걸고 시트별로 전기하는 매크로 1

Sub buntatu01()

'   フィルターをかけるシートを指定
    Dim bunkatumaeWs As Worksheet
    Set bunkatumaeWs = Worksheets(2)

'   繰り返し開始（3つ目～最後のシートまで）
    Dim i As Long
    For i = 3 To Worksheets.Count

'   転記先のシートを指定
        Dim wsName As String
        wsName = Worksheets(i).Name

'   フィルターをかけてE列を指定したシート名と一致したもののみ抽出して可視セルでコピぺ
        With bunkatumaeWs.Range("A1")
            .AutoFilter Field:=5, Criteria1:=wsName
            .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets(i).Range("A1")
            .AutoFilter
        End With

    Next i

'   ブックを閉じないで保存する
    ThisWorkbook.Save

End Sub