HOME > VBAサンプル集 > オートフィルタの結果のコピー

オートフィルタの結果のコピー

 オートフィルタでデータを絞り込んだら、今度は別のシートにコピーしましょう。まずは簡単に絞り込んだデータをコピーします。

 オートフィルタのデータは条件に一致したデータだけ表示している状態です。これはセルをコピーするだけで簡単に表示されているデータだけコピーし、貼り付けることができます。

 サンプルデータは「オートフィルタの設定」で使用したデータを利用します。

・データのコピー
Sub A_20170129_01()


With Sheets("Sheet1").Range("A1")
   .AutoFilter Field:=2, Criteria1:="山田商事(株)"
   .CurrentRegion.Copy Sheets("Sheet2").Range("A1")
End With


End Sub

オートフィルタのコピー

 上記の手順で簡単にデータをコピーすることができます。単純にコピーをするだけならこのままで構いません。次にデータをコピーする前に今のデータを削除すれば問題なく使用することができます。

 問題は連続してデータをコピーしたい場合です。初めにコピーしたデータの一番下の行にデータを追加する場合を考えてみましょう。そのままコピーすると先頭にタイトル行が入ってしまいます。回避するには二つの方法があります。

 一つはタイトル行ごとコピーしてきてタイトル行を削除する方法。もう一つは別シートに一度コピーしてタイトル行を除いたデータの行だけコピーして貼り付ける方法です。後者の場合はいったん作業シートを経由させるので必要な列だけ簡単に取り出すこともできます。

 この作業シートを作成する方法はVBAでは色々と応用することができます。

タイトル行ごとコピーしてきてタイトル行を削除する方法

 まずは一度コピーしたデータの一番下を指定します。

・データの一番下に追加するコード
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
・データを再度追加する。
Sub A_20170129_02()


With Sheets("Sheet1").Range("A1")
   .AutoFilter Field:=2, Criteria1:="山田商事(株)"
   .CurrentRegion.Copy  Sheets("Sheet2").Cells(Rows.Count,1).End(xlUp).Offset(1,0)
End With


End Sub

 上記のままだとタイトル行もコピーされてしまいます。よってタイトル行を削除しましょう。タイトル行は・・・そうです。初めにデータの一番下に追加するコードと同じです。よって、その行を変数に代入し、データをコピーする。そして最後にタイトル行を削除しましょう。

・データを追加してタイトル行削除する。
Sub A_20170129_03()


Dim My_Target As Range


Set My_Target = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  With Sheets("Sheet1").Range("A1")
    .AutoFilter Field:=2, Criteria1:="山田商事(株)"
    .CurrentRegion.Copy My_Target
  End With


My_Target.Resize(1, 6).Delete Shift:=xlUp


End Sub

 上記のコードを実行すると初めに絞り込んでコピーしたデータの下に、タイトル行のないデータを追加でコピーすることができます。

データの追加

作業シートを経由して必要な行だけコピーする方法

 次に作業シートを経由して行をコピーする方法です。手順としては作業シートに一度絞り込んだデータをコピーし、タイトル行以外をコピーし、必要なシートに貼り付けます。

 この方法を利用することで、連続的にコピーすることができます。作業シートを経由することで、必要な列だけ取り出すことも簡単にできます。作業シートを利用するテクニックは他の場面でも応用できるのでぜひ覚えておきましょう。

 まずは通常通りシートにデータをコピーします。次に絞り込んだデータを作業シートにコピーしましょう。先頭のタイトル行を削除し、データをシートにコピーします。最後に作業シートを削除します。

・作業シートを利用してコピーする。
Sub A_20170131_01()
Dim My_Target As Range


Set My_Target = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)


With Sheets("Sheet1").Range("A1")
   .AutoFilter Field:=2, Criteria1:="山田商事(株)"
   .CurrentRegion.Copy


  With Worksheets.Add
    .Paste
    .Rows(1).Delete
    .UsedRange.Copy My_Target
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
  End With


End With


End Sub

 やり方が違っても結果は同じです。タイトル行が無い状態でデータがコピーされています。

作業シートを経由

エクセル職人        VBAサンプル集目次

▲TOPへ移動