|
こんにちは
>あの、大変失礼ですが
>>If .Columns(1).Rows.Count = 1 Then
>これで抽出数は数えられないと思います。
ご指摘のとおりですスミマセン (^^;;
少し修正しました
Sub 抽出2()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim MyR As Range
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set MyR = sh2.Range("a2")
If MyR.Value = "" Then
MsgBox "A2値を入れてください"
Exit Sub
End If
sh2.Range("a6:e65536").ClearContents
With sh1.Range("a1").CurrentRegion
.AutoFilter 1, "*" & MyR.Value & "*"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "該当データはありません"
Else
.Offset(1).Copy sh2.Range("a6")
End If
.AutoFilter
End With
Set sh1 = Nothing
Set sh2 = Nothing
Set MyR = Nothing
End Sub
|
|