【ExcelVBA】オートフィルタで抽出したデータをコピー&ペースト

ExcelVBA, オートフィルタ

テスト対象のテーブル



テスト対象テーブルを使いたい場合は、↓テーブルをコピーしてエクセルの A1 に貼り付けてください。



商品名個数
りんご4
みかん3
めろん5
いちご2
みかん1

抽出したデータを他シートへコピー

Sub Sample()
 
  Dim FilterWS As String
  Dim TargetWS As String
  
  FilterWS = "Sheet1"
  TargetWS = "Sheet2"
 
	ThisWorkbook.Worksheets(FilterWS).Range("A1:B1").AutoFilter _
  	Field:=1, _
  	Criteria1:="みかん"

  With ThisWorkbook
    .Worksheets(FilterWS).Cells(1, 1).CurrentRegion.Copy
    .Worksheets(TargetWS).Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths '列幅貼り付け
		.Worksheets(TargetWS).Cells(1, 1).PasteSpecial Paste:=xlPasteAll          'すべて貼り付け
  End With
 
End Sub

※xlPasteAll は列幅を含まないため、xlPasteColumnWidths で列幅を事前に貼り付けしています。

結果(Sheet2)


実行前のテーブル(Sheet1)


抽出したデータを他シートへコピー(汎用例)

「個数1 の みかん」および「個数4 の りんご」の条件で抽出して他シートへ貼り付けするサンプルです。
Sub Main()
  
  Dim TableWS As String, PasteWS As String
  
  TableWS = "Sheet1" 'テーブルシート
  PasteWS = "Sheet2" '貼り付け先シート
    
  ThisWorkbook.Sheets(PasteWS).Cells.Clear
    
  Call HeaderPaste(TableWS, PasteWS)
  Call DataPaste(TableWS, PasteWS, "みかん", "=1")
  Call DataPaste(TableWS, PasteWS, "りんご", "=4")
  
End Sub
  
Sub HeaderPaste(TableWS, PasteWS)

    ThisWorkbook.Sheets(TableWS).Range("A1:B1").Copy
    ThisWorkbook.Sheets(PasteWS).Range("A1:B1").PasteSpecial Paste:=xlPasteAll

End Sub
  
Sub DataPaste(TableWS, PasteWS, V1, V2)
    
    ThisWorkbook.Sheets(TableWS).Cells(1, 1).AutoFilter _
      Field:=1, _
      Criteria1:=V1
    
    ThisWorkbook.Sheets(TableWS).Cells(1, 1).AutoFilter _
      Field:=2, _
      Criteria1:=V2
    
    ThisWorkbook.Sheets(TableWS).Cells(1, 1).CurrentRegion.Offset(1).Copy
         
    With ThisWorkbook.Sheets(PasteWS).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
      .PasteSpecial Paste:=xlPasteColumnWidths '列幅
      .PasteSpecial Paste:=xlPasteAll          'すべて
    End With
    
  ThisWorkbook.Sheets(TableWS).AutoFilterMode = False
      
End Sub

結果(Sheet2)


実行前のテーブル(Sheet1)


オートフィルタでデータ抽出のあれこれを知りたい場合は、こちらです。


PasteSpecialメソッドの説明

オプション一覧

単純な貼り付け作業のみをさせたいのであれば、Paste オプションだけで足ります。

オプション説明
PasteXlPasteAllやxlPasteValuesなど、貼り付ける範囲の部分を指定します。
OperationXlPasteSpecialOperationAddなどの貼り付け操作。
SkipBlanksTrueを指定すると、クリップボードの範囲内の空白セルが貼り付け先の範囲に貼り付けられません。 既定値は False です。
TransposeTrueを指定すると、行と列が貼り付けられます。 既定値は False です。
使用例
With Worksheets("Sheet1")
    .Range("C1:C5").Copy
    .Range("D1:D5").PasteSpecial Operation:=xlPasteSpecialOperationAdd
End With

Pasteオプションの定数

値のみを貼り付けしたい場合は、xlPasteValues を使い、書式も一緒に貼り付けたしたい場合は、xlPasteAll を使います。
その他もろもろの定数一覧は下になります。

定数説明
xlPasteAll(既定)すべて
xlPasteFormulas数式
xlPasteValues
xlPasteFormats書式
xlPasteCommentsコメント
xlPasteValidation入力規則
xlPasteAllExceptBorders罫線を除く全て
xlPasteColumnWidths列幅
xlPasteFormulasAndNumberFormats数式と数値の書式
xlPasteValuesAndNumberFormats値と数値の書式
xlPasteAllUsingSourceThemeコピー元のテーマを使用してすべて貼り付け
xlPasteAllMergingConditionalFormatsすべての結合されている条件付き書式
※行高を貼り付けする定数はありません(>_<)

Operationオプションの定数

名前説明
xlPasteSpecialOperationNone(既定)貼り付け操作で計算は行われません。
xlPasteSpecialOperationAddコピーしたデータは、貼付先セルの値に加算します。
xlPasteSpecialOperationSubtractコピーしたデータは、貼付先セルの値を減算します。
xlPasteSpecialOperationMultiplyコピーしたデータで、貼付先セルの値を乗算します。
xlPasteSpecialOperationDivideコピーしたデータで、貼付先セルの値を除算します。