VBAでオートフィルタで抽出したデータを取り出して表を作成する

2021年7月7日2021年7月11日

エクセルシート上のボタンをクリックだけで、オートフィルタで抽出したデータを別な表に貼り付ける事ができます。
このサンプルアプリを応用すると、あるデータから必要なデータを取り出して新たに表を作成する業務がボタン一発で行えるようになります。

サンプルアプリの説明

「オートフィルタを使って表作成」ボタンをクリックすると、左の表から「E会社」を抽出して、右側の表に抽出したデータを貼り付けることができます。
貼り付けた表は「表の削除」ボタンで削除することができます。
オートフィルタの解説はこちらをご覧ください。　→　ボタン一発オートフィルタ

サンプルアプリのソースコード　　コードの作成手順はこちら

「オートフィルタを使って表を作成」ボタンのコード

Sub AutoFilter表作成()
  
  'ワークシートを指定する
  Dim Sh1 As Worksheet
  Set Sh1 = ThisWorkbook.Worksheets("Sheet1")
  
  'オートフィルタを設定する（E会社を抽出）
  Sh1.Range("B4:C14").AutoFilter _
    Field:=1, _
    Criteria1:="E会社"
  
  '抽出データの最終行を取得する
  Dim MaxRow As Long
  MaxRow = Sh1.Cells(Rows.Count, 2).End(xlUp).Row
 
  '抽出した結果を指定先にコピー
  Range(Cells(5, 2), Cells(MaxRow, 3)).Copy Sh1.Cells(5, 6)

  'オートフィルタを解除
  Sh1.AutoFilterMode = False
  
  'コピーモードを解除
  Application.CutCopyMode = False
  
  'カーソルをA1に置く
  Range("A1").Select
  
End Sub

「表の削除」ボタンのコード

Sub 表削除()

  'ワークシートを指定する
  Dim Sh1 As Worksheet
  Set Sh1 = ThisWorkbook.Worksheets("Sheet1")

  'データの最終行を取得
  Dim MaxRow As Long
  MaxRow = Sh1.Cells(Rows.Count, 6).End(xlUp).Row

  '作成されていた表を削除
  Call Range(Cells(5, 6), Cells(MaxRow, 7)).Delete(xlShiftUp)

End Sub