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

質問

マクロ初心者のため、やり方が全くわかりません。
どなたか教えてください。
やりたいことは、

【１】シート名「データ」をＡ列でオートフィルタ抽出して、別シートにコピーする。

【２】別シートにコピーしたデータに外枠罫線をつける。

【３】シート名「データ」には塗りつぶしがあるので、別シートにコピーされた塗りつぶしは「なし」する。

【４】シート名「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

回答No.1

zap35 · ベストアンサー

データシートをインデックス（あ行　等）で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

補足

早々のご回答、本当にありがとうございます！
とても助かりました。勉強になります！
よろしければ追加で教えていただきたいのですが、

「データ」シートから抽出して、新規シートに貼り付ける時に、
列幅も同時に貼り付けることは可能でしょうか？

また、別Bookに移す前に「sheet1」の１～２行（タイトル名が書いてあります）をコピーして、
「あ行」の１～２行目に挿入したいのですが、どうすればよいのでしょうか？

回答No.2

zap35

＃０１です
＞列幅も同時に貼り付けることは可能でしょうか？
　.Columns("A:Z").Copy
　Activesheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
を挿入します

＞「sheet1」の１～２行（タイトル名が書いてあります）をコピーして、
＞「あ行」の１～２行目に挿入したいのですが、
　.Rows("1:2").Copy
　Activesheets.Range("A1").Insert Shift:=xlDown
を挿入します

どこに挿入すればうまくいくかは、ご自身で考えて試してみてください
（そうでないと丸投げになってしまいますから…）

お礼

親切に回答していただき、本当にありがとうございました。
おかげさまで、列幅貼り付けもタイトル挿入もなんとか組み込むことができました。
これから、もっともっと勉強していきたいと思います。