Excel。VBA。抽出したデータの見出し行を除いて別シートにコピーしたい
＜VBA＞
データを読み込んだ後に、抽出だけを行って作業終了というよりも、その抽出したデータを別シートにコピーするなど、抽出後の作業が伴うことになるかと思います。
抽出したデータをコピーすること自体は、厄介ではないのですが、「見出し行」を除いてデータのみを別シートにコピーしたい場合は、どのようにしたらいいのでしょうか。
コピーする範囲をOffsetなどつかって、見出し行を除いた範囲を設定する方法もあるかもしれませんが、CurrentRegionプロパティをつかうことで、見出し行も含めてコピーすることができます。
そのため、コピーした後に見出し行を削除するほうが、簡単にデータのみにすることができます。
次のデータを使います。
店舗番号が3の品川店のデータのみを別シートにコピーするプログラム文を作っていきます。
Sub 見出し行除き()
Range("a1").AutoFilter field:=2, Criteria1:=3
If WorksheetFunction.Subtotal(3, Range("b:b")) > 1 Then
Worksheets.Add after:=Sheets(Sheets.Count)
Worksheets("data").Range("a1").CurrentRegion.Copy Range("a1")
Range("a1").EntireRow.Delete
Worksheets(Sheets.Count).Name = "copy"
Worksheets("data").Range("a1").AutoFilter
End If
End Sub
とてもシンプルなプログラム文で、見出し行を除いてコピーすることができます。
それでは、実行してみましょう。
このように、別シートに見出し行を除いたデータのみをコピーすることができました。
プログラム文を見ていきましょう。
Range("a1").AutoFilter field:=2, Criteria1:=3
この行は、オートフィルターをつかって抽出作業を行っています。
AutoFilter で、オートフィルターを設定します。
field:=2 は、左から2列目のフィールドを指しますので、「店舗番号」の列が該当します。
Criteria1:=3 の「Criteria」は条件。
つまり抽出条件のことなので、「3」の品川店を抽出する設定のオートフィルターを設定することができます。
If WorksheetFunction.Subtotal(3, Range("b:b")) > 1 Then ～End If
このIf文は、何をやっているのかというと、該当するデータがあれば、それ以降を実行して、抽出データがなければ、実行しないためのプログラム文です。
WorksheetFunction.Subtotal は、ワークシート関数のSubtotal関数をつかって、データのあるなしを確認しています。
Worksheets.Add after:=Sheets(Sheets.Count)
データがあることが判明したので、コピーを行うわけですが、コピー先のシートがないので、Worksheets.Add でシートを追加します。
なお、after:=Sheets(Sheets.Count)で、最終シートの後ろにシートを追加させます。Sheets.Count でブック内のシートの枚数を確認することができます。
Worksheets("data").Range("a1").CurrentRegion.Copy Range("a1")
追加したシートのA1に、抽出したデータをコピーします。
Range("a1").EntireRow.Delete
コピーしたデータの、1行目を削除します。これで、見出し行を除いたデータにすることができました。
Worksheets(Sheets.Count).Name = "copy"
追加したシート名が設定されていませんので、「copy」というシート名で設定します。
Worksheets("data").Range("a1").AutoFilter
コピー作業が終了したので、抽出するためのオートフィルターを解除します。
これ以外にも、様々な方法で作ることができますので、色々考えてみるのもいいかもしれませんね。
