필터를 걸어 시트마다 전기하는 매크로 3

이번에는
"시트와 일치하는 항목을 필터로 추출하고 가시 셀로 복사"
매크로를 특정 열의 단어를 기반으로 시트를 자동으로 생성하도록 수정했습니다.

시트의 자동 생성입니다만, 아래 그림의 방법으로 「매크로」시트의 A열의 셀을 참조해 시트를 작성할 수 있도록, 코드를 추가했습니다.

Option Explicit

Sub buntatu03()

'   マクロシート、分割前シートを変数で宣言
    Dim makuroWs As Worksheet
    Set makuroWs = Worksheets(1)
    Dim bunkatumaeWs As Worksheet
    Set bunkatumaeWs = Worksheets(2)

'   分割前シートのE列をマクロシートのA列にコピペする
    With bunkatumaeWs
        .Activate
        Range("E:E").Copy makuroWs.Range("A1")
    End With

'   マクロシートのA列の重複を削除し、昇順に並び替える
    With makuroWs
        .Activate
        Range("A:A").RemoveDuplicates Columns:=Array(1), Header:=xlYes
        Range("A1").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
    End With

'   マクロシートのA列の最下行を確認
    Dim makuroLastLine As Long
    makuroLastLine = makuroWs.Cells(Rows.Count, 1).End(xlUp).Row
    Debug.Print makuroLastLine

'   A列の2行目以降のセルに記載された名前のシートを作る
    Dim j As Long
    For j = 2 To makuroLastLine

        Worksheets.Add After:=Sheets(j)

        Dim newWs As Worksheet
        Set newWs = Worksheets(1 + j)

        Dim group As String
        group = makuroWs.Cells(j, 1)
        newWs.Name = group

    Next j

'   新しく作ったシートに「課」ごとに内容を転記する（フィルターで抽出→可視セルでコピペ）
    Dim i As Long
    For i = 3 To Worksheets.Count

        Dim wsName As String
        wsName = Worksheets(i).Name
        Debug.Print wsName

        With bunkatumaeWs.Range("A1")
            .AutoFilter Field:=5, Criteria1:=wsName
            .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets(i).Range("A1")
            .AutoFilter
        End With

    Next i

'   マクロシートのA列を削除しセルA1を選択して保存する
    With makuroWs
        .Activate
        Range("A:A").Delete
        Range("A1").Activate
    End With
    ThisWorkbook.Save

End Sub

매크로에 조작을 맡기고 있는 부분이 많기 때문에, 인적 미스도 적어질 것 같습니다!
이 매크로는 일단 여기에서 완료됩니다.

다음 번에는 피벗을 사용하여 매크로를 만들 예정입니다.