マクロの修正ができません

質問

エクセルのマクロで下記の作業をしています。
よくわからないまま使っているので障害箇所がわかりません。
教えていただけないでしょうか・・
説明の仕方も下手で申し訳ありませんがよろしくお願いいたします。

[マクロの用途]
・別シートに請求データを作成しています。
・請求番号を入力するセルに請求番号を入力します。
・登録したマクロボタンを押すと抽出範囲に該当する請求書のデータが抽出されます。

[障害の内容]
請求データが４行以上になると、３行まで抽出され、
４行以降は抽出されません。

以下はマクロの内容です。

Sub 抽出()
'
' 抽出 Macro
' マクロ記録日 : 2007/2/19 ユーザー名 : ＊＊＊'
Dim myRow1 As Long, myRow2 As Long
myRow1 = Sheets("データ").Range("B65536").End(xlUp).Row
myRow2 = Sheets("抽出範囲").Range("B65536").End(xlUp).Row
If myRow2 >= 5 Then
Sheets("抽出範囲").Range("A4:Q40" & myRow2).ClearContents
End If
Sheets("データ").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A4:Q40"), Unique:=True
End Sub

回答No.2

hige_082 · ベストアンサー

別におかしくないと思う
重複は表示しないの設定をするにしただけ

Sub 抽出()
'
' 抽出 Macro
' マクロ記録日 : 2007/2/19 ユーザー名 : ＊＊＊'
Dim myRow1 As Long
Dim myRow2 As Long

myRow1 = Sheets("データ").Range("B65536").End(xlUp).Row
myRow2 = Sheets("抽出範囲").Range("B65536").End(xlUp).Row

If myRow2 >= 5 Then
Sheets("抽出範囲").Range("A4:Q40" & myRow2).ClearContents
End If

Sheets("データ").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A4:Q40"), Unique:=False
End Sub

お礼

ありがとうございます。
Unique:=False
にしたところ、全部抽出されました。
大変助かりました。

回答No.1

某HN クロメート(Chromate)（@CoalTar）

マクロ苦手なんで当てにならないかもしれませんが
Sub 抽出()
Sheets("抽出範囲").Select
Dim myRow1 As Long, myRow2 As Long
myRow1 = Sheets("データ").Range("B65536").End(xlUp).Row
myRow2 = Sheets("抽出範囲").Range("B65536").End(xlUp).Row
If myRow2 >= 5 Then
'範囲をあわせるなら
Sheets("抽出範囲").Range("A4:Q" & myRow2).ClearContents
End If
Sheets("データ").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A4:Q4"), _
Unique:=False '同一データを削除しない
End Sub

お礼

ありがとうございます。
いただいたプログラム通り、
間違いなく実行されました。
助かりました。