|
▼たけちゃんまん さん
オートフィルター版も。
ただし、xl2007以降限定。
Sub Sample2() 'オートフィルター
Dim cols As Long
Dim r As Range
Dim shT As Worksheet
Application.ScreenUpdating = False
Set shT = Sheets("Sheet2") '転記シート
shT.UsedRange.ClearContents
With Sheets("Sheet1") '元シート
cols = .UsedRange.Columns.Count
Set r = .Range("A1", .UsedRange).Offset(1)
.AutoFilterMode = False
r.AutoFilter Field:=9, Criteria1:=Array("b001", "b002", "b003"), Operator:=xlFilterValues
If r.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then r.Copy shT.Range("A1")
.AutoFilterMode = False
End With
shT.Select
End Sub
|
|