抽出してコピペ 検索すべき文字が存在しない場合は？

質問

エクセルのマクロを使って、売上帳を作成しています。
下のようなコードで、F2に顧客番号を入れると、売上帳シート内から選んだ顧客のみの売上明細が個別売上帳シートに移るように作っています。
そこで問題なのですが、売上帳シート内に存在しない顧客番号（取引がなかった顧客）を抽出しようとすると、全明細がそっくり抽出されてしまいます。
私としては、その場合は抽出すべきものがないとして、個別売上帳シートは空欄にしてしまいたいのですが、どうすればよいでしょう？
教えてください。

Sub 顧客抽出コピペ()
Sheets("売上帳").Select
Range("B6").AutoFilter Field:=2, Criteria1:=Range("F2").Value '2つ目のフィルターに検索文字
Range("B5:B2005").Select
Selection.Copy
Sheets("個別売上帳").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("売上帳").Select
Range("E5:J2005").Select
Selection.Copy
Sheets("個別売上帳").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

回答No.1

merlionXX · ベストアンサー

エクセル2003で試しましたが、検索値が見つからない場合、Autofilterには何も表示されず、結果として全明細がそっくりコピペされないのですが、yunako0517さんのではそうなるのですね？
では、検索値が見つからない場合コピペせず、個別売上帳の"B5:H2005"もクリアするようにコードを直してみました。
これでどうでしょう？

Sub 顧客抽出コピペ()
　　Dim Obj As Object
　　With Sheets("売上帳")
　　　　Set Obj = .Range("B5:B2005").Find(.Range("F2"), LookAt:=xlWhole)
　　　　If Obj Is Nothing Then
　　　　　　MsgBox "見つかりませんでした。"
　　　　　　Sheets("個別売上帳").Range("B5:H2005").ClearContents
　　　　　　Exit Sub
　　　　Else
　　　　　　.Range("B6").AutoFilter Field:=2, Criteria1:=.Range("F2").Value
　　　　　　.Range("B5:B2005").Copy
　　　　End If
　　End With
　　Sheets("個別売上帳").Range("B5").PasteSpecial Paste:=xlPasteValues
　　Sheets("売上帳").Range("E5:J2005").Copy
　　Sheets("個別売上帳").Range("C5").PasteSpecial Paste:=xlPasteValues
　　Application.CutCopyMode = False
End Sub

補足

教えていただいたコードで参照セルを少し調整したら出来ました！
ありがとうございます。

ただ、検索値が見つからない場合に、売上帳シート内にオートフィルタの表示が出たままになりますが、これを消すにはどうすればよいですか？
検索値がある場合には、売上帳シートに戻したらオートフィルタ表示は出ていません。

回答No.2

merlionXX

yunako0517さんのエクセルのバージョンは何ですか？
おっしゃることが再現できずに困惑しています。
お書きになったコードから推測するにオートフィルターはA5～J5に設置しているのでしょうか？

これならどうでしょう？

Sub 顧客抽出コピペ02()
　　Dim Obj As Object
　　With Sheets("売上帳")
　　　　If .AutoFilterMode = False Then
　　　　　　.Range("A5:J5").AutoFilter
　　　　End If
　　　　Set Obj = .Range("B5:B2005").Find(.Range("F2"), LookAt:=xlWhole)
　　　　If Obj Is Nothing Then
　　　　　　MsgBox "見つかりませんでした。"
　　　　　　Sheets("個別売上帳").Range("B5:H2005").ClearContents
　　　　　　.AutoFilterMode = False
　　　　　　Exit Sub
　　　　Else
　　　　　　.Range("B5").AutoFilter Field:=2, Criteria1:=.Range("F2").Value
　　　　　　.Range("B5:B2005").Copy
　　　　End If
　　　　.AutoFilterMode = False
　　End With
　　Sheets("個別売上帳").Range("B5").PasteSpecial Paste:=xlPasteValues
　　Sheets("売上帳").Range("E5:J2005").Copy
　　Sheets("個別売上帳").Range("C5").PasteSpecial Paste:=xlPasteValues
　　Application.CutCopyMode = False
End Sub

それから、「補足」に書かれてもわたしのところに通知はきませんので、このように古い質問に補足があったことを知ることはほとんどできません。（今夜はたまたま見つけましたが）

お礼

ありがとうございました。
merlionXXさんのおかげでできました。
また宜しくお願いします。