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

2019.05.22ExcelVBA,オートフィルタ

テスト対象のテーブル

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

クリップボードにコピー

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

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 オプションだけで足ります。

オプション	説明
Paste	XlPasteAllやxlPasteValuesなど、貼り付ける範囲の部分を指定します。
Operation	XlPasteSpecialOperationAddなどの貼り付け操作。
SkipBlanks	Trueを指定すると、クリップボードの範囲内の空白セルが貼り付け先の範囲に貼り付けられません。 既定値は False です。
Transpose	Trueを指定すると、行と列が貼り付けられます。 既定値は 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	コピーしたデータで、貼付先セルの値を除算します。