エクセルマクロ　抽出したデータを別のシートへコピーしたい

Question

マクロ初心者のため、やり方が全くわかりません。
どなたか教えてください。
やりたいことは、

【１】シート名「データ」をＡ列でオートフィルタ抽出して、別シートにコピーする。

【２】別シートにコピーしたデータに外枠罫線をつける。

【３】シート名「データ」には塗りつぶしがあるので、別シートにコピーされた塗りつぶしは「なし」する。

【４】シート名「Sheet1」の１～２行目をコピーし、別シートの１～２行目に挿入し、シート名「データ」に戻る。

コピーするシートはあらかじめ作成しています。
簡素化の方法がわからないので、
とりあえず自分で作ってみたものが下にあるものです。

繰り返す方法がわからないので、今はコピーして「あ行」の部分を書き換えています。（かなり面倒です）

最終的には、抽出されたそれぞれのシートを別々のブックにしたいとも思っています。
長々とすみませんが、どなたか教えてください。
よろしくお願いします。

以下、作成したマクロです。

    Sheets("データ").Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    
    Selection.AutoFilter Field:=1, Criteria1:="あ行", Operator:=xlAnd
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("あ行").Select
    Range("A1").Select
    ActiveSheet.Paste

    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
 
    Cells.Select
    Selection.Interior.ColorIndex = xlNone

    Sheets("Sheet1").Select
    Rows("1:2").Select
    Selection.Copy
    Sheets("あ行").Activate
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1").Select

    Sheets("データ").Select
    Range("A1").Select

zap35 · Accepted Answer

データシートをインデックス（あ行　等）でFilterしてそれぞれを別ブックにコピーするマクロのサンプルです。１００％期待する結果になるところまでの自信はありませんが、ご参考まで。

Sub Macro2()
Dim wb As Workbook
Dim str() As String
Dim idx As Integer
　Set wb = ThisWorkbook
　str = Split("あ行,か行,さ行,た行,な行,は行,ま行,や行,ら行,わ行", ",")
　Application.ScreenUpdating = False
　With wb.Worksheets("データ")
　　If .AutoFilterMode Then
　　　.Cells.AutoFilter  '一旦AutoFilterを解除し
　　End If
　　.Columns("A:A").AutoFilter  'A列に再度AutoFilterを設定
　　For idx = 0 To UBound(str)
　　　.Columns("A:A").AutoFilter Field:=1, Criteria1:=str(idx)
　　　.Range(.Range("A1"), .Cells.SpecialCells(xlLastCell)).Copy
　　　Worksheets.Add  'シートを追加
　　　ActiveSheet.Name = str(idx)
　　　ActiveSheet.Paste
　　　ActiveSheet.Cells.Interior.ColorIndex = xlNone
　　　Range(Range("A1"), Cells(1, 1).SpecialCells(xlLastCell)) _
　　　　　.Borders.LineStyle = xlContinuous
　　　Range("A1").Select
　　　ActiveSheet.Move  '追加したシートを別Bookに移す
　　Next idx
　　.Cells.AutoFilter
　　wb.Activate
　End With
　Application.ScreenUpdating = True
End Sub

zap35 · Answer

＃０１です
＞列幅も同時に貼り付けることは可能でしょうか？
　.Columns("A:Z").Copy
　Activesheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
を挿入します

＞「sheet1」の１～２行（タイトル名が書いてあります）をコピーして、
＞「あ行」の１～２行目に挿入したいのですが、
　.Rows("1:2").Copy
　Activesheets.Range("A1").Insert Shift:=xlDown
を挿入します

どこに挿入すればうまくいくかは、ご自身で考えて試してみてください
（そうでないと丸投げになってしまいますから…）

エクセルマクロ 抽出したデータを別のシートへコピーしたい

データシートをインデックス（あ行 等）でFilterしてそれぞれを別ブックにコピーするマクロのサンプルです。

この回答への補足

＃０１です

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセルマクロ　抽出したデータを別のシートへコピーしたい

データシートをインデックス（あ行　等）でFilterしてそれぞれを別ブックにコピーするマクロのサンプルです。