VBA 請求書の自動印刷について

質問

VBAで請求書の連続印刷について質問です。

Sheet("基本情報")のA列に請求書No. B列に請求日が記載されております。
ComboBoxで入力されている請求日を選択することで、該当の全データを請求書フォーマットに転記して、全て印刷するマクロを組んでみたのですがうまくいきません。

流れとしては以下の通りです。

１、ComboBoxで請求日を選択(20日)

２、Sheet("基本情報")から、請求日が20日に該当するデータをSheet("請求書")に転記

３、Sheet("基本情報")の請求日が20日でA列の請求書Noと一致する、Sheet("詳細")の該当データを Sheet("請求書")に転記

４、印刷したら、入力データをクリアしてから、次の該当データを転記

Loop

と、したいのですが、１～入力データのクリアまでは問題なく作動するのですが、次の該当データに移行しません。
MsgBoxでAddressの表示を行ったところ、たまに関係ないセルのアドレスの表示も確認でき、全くわからなくなってしまいました。

何卒、御教授の程お願い致します。
また、作成中のため、記述の整理は出来ておりませんが、併せて御教示頂ければ幸いです。

Private Sub CommandButton1_Click()

Dim Ws As Worksheet, ws2 As Worksheet, pSht As Worksheet
Dim StrFind As String, Res As String, _
firstAddress As String, buf As String
Dim rg As Range, rg1 As Range
Dim 選択行 As Integer, 選択行1 As Integer
Dim i As Long, A As Long, MinRow As Long

buf = Year(Date) & "/" & Month(Date) & "/"

StrFind = ComboBox1.Value
Set Ws = Worksheets("請求書")
Set ws2 = Worksheets("詳細")
Set pSht = Worksheets("基本情報")

If StrFind = "" Then
MsgBox "送付日を指定してください。"
Exit Sub
End If

With pSht
Set rg = .Columns(2).Find(What:=StrFind, LookAt:=xlWhole)
選択行 = rg.Row
Set rg1 = ws2.Columns(1).Find(What:=.Cells(選択行, 1))
選択行1 = rg1.Row

If Not rg Is Nothing Then
firstAddress = rg.Address

Do
DoEvents

'~~~~~ここに転記の構文　およそ200行前後~~~~~

Set rg = .Columns(2).FindNext(rg)
If rg Is Nothing Then Exit Do
Loop Until rg.Address = firstAddress
Unload Me
End If
End With
End Sub

回答No.1

imogasi

日付を検索するところに問題があるのでは？
質問のコードを多少変えて、日付け検索部分を中心に残し、他をそぎ落としてテストした。
適当にコメントを入れた。
Set Ws = Worksheets("請求書")式の書き方は、初めて（今回限り）コードに接する他人（小生）にはわかりやすいと思い、具体的に書く方式に変えた。
質問者のデータの場合の下記　StrFind = "3/6/2016"の日付をいろいろ変えて、うまく該当を
掴むと確信するようになったら、それ以下の処理に進むべきとおもう。
Sub test01()
Dim Ws As Worksheet, ws2 As Worksheet, pSht As Worksheet
Dim StrFind As String, Res As String, _
firstAddress As String, buf As String
Dim rg As Range, rg1 As Range
Dim 選択行 As Integer, 選択行1 As Integer
Dim i As Long, A As Long, MinRow As Long

buf = Year(Date) & "/" & Month(Date) & "/"

StrFind = #3/6/2016# 'ComboBox1.Value '請求日
'--
Set Ws = Worksheets("請求書")
Set ws2 = Worksheets("詳細")
Set pSht = Worksheets("基本情報")
'--

If StrFind = "" Then
MsgBox "送付日を指定してください。"
Exit Sub
End If
StrFind = "3/6/2016" 'ComboBox1.Value '請求日
Set rg = Worksheets("基本情報").Columns(2).Find(What:=StrFind, LookIn:=xlValues) ' 請求日で検索 該当の最初の１セルをつかむ
'---該当日付なし
If rg Is Nothing Then
MsgBox "該当日付なし"
Exit Sub
End If
'--該当あり
MsgBox rg.Offset(0, -1)
'請求NOを取った後の処理に飛ぶ　略
'選択行 = rg.Row
'Set rg1 = Worksheets("基本情報").Columns(1).Find(What:=.Cells(選択行, 1))
'選択行1 = rg1.Row

'If Not rg Is Nothing Then
firstAddress = rg.Address

Do
DoEvents

'~~~~~ここに転記の構文　およそ200行前後~~~~~
'--該当第2件目以降あるか。該当が１件でもここを通る
Set rg = Worksheets("基本情報").Columns(2).FindNext(rg)
MsgBox rg.Offset(0, -1)
Loop Until rg.Address = firstAddress '検索結果の最初の行に戻ったら該当する行は終了
' Unload Me
'End If
' End With
End Sub
Ｆｉｎｄの処理は初心者にはむつかしく、下記も参考にしてください。
http://officetanaka.net/excel/vba/tips/tips131b.htm
ちなみに
Find(What:=#3/6/2016＃のような書き方もＯＫのようだ。
小生のテストデータは
請求NO 請求日
1 2016/3/2
2 2016/3/2
3 2016/3/2
4 2016/3/2
5 2016/3/2
6 2016/3/5
7 2016/3/6
8 2016/3/6
9 2016/3/6
10 2016/3/6
11 2016/3/6
のようなものを作った。
仕組みとして、Sheet("基本情報")からSheet("詳細")に行く（中間がある）ところが構成として面倒だな。