Sub TEST1()
'東京をフィルタ
Range("A1").AutoFilter 2, "東京"
'フィルタ結果をセルにコピー
Range("A1").CurrentRegion.Copy Range("E1")
'オートフィルタを解除
Range("A1").AutoFilter
End Sub
Sub TEST2()
'東京をフィルタ
Range("A1").AutoFilter 2, "東京"
'見出し以外のフィルタ結果をセルにコピー
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).Copy Range("E1")
End With
'オートフィルタを解除
Range("A1").AutoFilter
End Sub
表を用意しておきます。
表を用意
では、VBAコードを実行してみます。
「見出しを除いて」フィルタ結果をコピーできた
「見出しを除いて」フィルタ結果をコピーできました。
ちょっとややこしいので、手順を追って解説してみます。
手順を解説
手順の解説です。
「東京」をフィルタ
最初に「東京」をフィルタします。
'東京でフィルタ
Range("A1").AutoFilter 2, "東京"
実行します。
「東京」でフィルタができます。
「.Resize」で1行小さくする
「.Resize」で1行小さくします。
'全てのセル範囲
With Range("A1").CurrentRegion
'行数を「1つだけ減らす」
.Resize(.Rows.Count - 1).Select
End With
'全てのセル範囲
With Range("A1").CurrentRegion
'行数を1つだけ減らして「1行下に移動」する
.Resize(.Rows.Count - 1).Offset(1, 0).Select
End With
実行してみます。
「.Offset」で1行下に移動できています。
フィルタ結果をコピー
フィルタ結果をコピーします。
'見出しを除くフィルタ結果をコピー
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
End With
実行します。
フィルタ結果がコピーモードになりました。
セルに貼り付ける
セルに貼り付けます。
'見出しを除くフィルタ結果をコピーして貼り付け
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).Copy Range("E1")
End With
実行します。
見出しを除くフィルタ結果を、セルに貼り付けることができました。
オートフィルタを解除
オートフィルタを解除します。
'オートフィルタを解除
Range("A1").AutoFilter
実行します。
オートフィルタを解除できました。
こんな感じで、見出しを除いてフィルタ結果をコピーすることができます。
フィルタ結果がある場合だけコピーする
少し注意するポイントで、フィルタ結果がある場合だけコピーする必要があります。
フィルタ結果がない場合すべてコピーされちゃう
フィルタ結果がない場合に、コピーをしてしまうと、すべてコピーされてしまいます。
Sub TEST3()
'表にないデータでフィルタ
Range("A1").AutoFilter 2, "沖縄"
'見出しを除くフィルタ結果をセルにコピー
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).Copy Range("E1") '←データ全てを貼り付けてしまう
End With
'フィルタ解除
Range("A1").AutoFilter
End Sub
Sub TEST4()
'表にないデータでフィルタ
Range("A1").AutoFilter 2, "沖縄"
'フィルタ結果がある場合だけ
If WorksheetFunction.Subtotal(3, Range("A:A")) > 1 Then
'見出しを除くフィルタ結果をセルにコピー
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).Copy Range("E1")
End With
End If
'オートフィルタ解除
Range("A1").AutoFilter
End Sub
Sub TEST5()
'東京をフィルタ
Range("A1").AutoFilter 2, "東京"
'見出しを除いてフィルタ結果を削除
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).Delete
End With
'オートフィルタを解除
Range("A1").AutoFilter
End Sub
Sub TEST6()
'東京をフィルタ
Range("A1").AutoFilter 2, "東京"
'見出しを除いてフィルタ結果を削除
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).EntireRow.Delete
End With
'オートフィルタを解除
Range("A1").AutoFilter
End Sub
表を用意しておきます。
表を用意
実行してみます。
表示を出さないで削除できた
表示を出さないでフィルタ結果を削除できました。
フィルタ結果がある場合だけ削除する
削除する場合もフィルタ結果がある場合だけ、削除する必要があります。
フィルタ結果がない場合すべて削除されちゃう
フィルタ結果がない場合に、削除してしまうと、見出し以外のすべてのデータが削除されてしまいます。
Sub TEST7()
'表にないデータでフィルタ
Range("A1").AutoFilter 2, "沖縄"
'見出しを除くフィルタ結果を削除
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).EntireRow.Delete '見出し以外のデータがすべて削除されちゃう
End With
'オートフィルタ解除
Range("A1").AutoFilter
End Sub
Sub TEST8()
'表にないデータでフィルタ
Range("A1").AutoFilter 2, "沖縄"
'フィルタ結果がある場合
If WorksheetFunction.Subtotal(3, Range("A:A")) > 1 Then
'見出しを除くフィルタ結果を削除
With Range("A1").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).EntireRow.Delete
End With
End If
'オートフィルタを解除
Range("A1").AutoFilter
End Sub
