【VBA】ボタンで実行するとうまく作動しません。

はじめまして。
皆様のお知恵を貸してください！

【1.やりたいこと】
キーを検索し、該当するものがなくなるまで印刷をかけたい

【2.エクセルの中身】
シートは全部で2つあり、①データ ②1)定期 という名前にしてあります。
①データシートに個人情報を入力する欄を設けてあり、A～L列までの表になっています。
K列に1または2の数字を入れており、これをキーとし、1ならA列を参照し、 ②1)定期シートのS4セルに貼り付けてVLOOKUPして印刷、これをキーがなくなるまで連続印刷したいのです。

そこで、以下のように設定してみました。
しかし、VBAのSub/ユーザーフォームの実行(F5)では連続で印刷をかけてくれるのですが、
ボタンにマクロを登録し、ボタンをクリックしてみると、1つしか印刷をかけてくれません。
（VBAのSub/ユーザーフォームの実行(F5)でやっても完璧とは言えず、上から順番に印刷されず、ばらばらに印刷されます。。。）

どうすれば理想どおりに実行できるようになりますでしょうか。
ご教授いただきたくお願い申し上げます。

↓↓

Sub 定期個人票()

Dim sh As Worksheet, i As Long

Set sh = Worksheets("1)定期")
Set FoundCell = Range("$K$3:$K2000").Find(What:=1)

If FoundCell Is Nothing Then
MsgBox "定期受診者なし"
Exit Sub
Else
Set FirstCell = FoundCell
On Error Resume Next
FoundCell.Offset(0, -10).Copy
sh.Range("$S$4").PasteSpecial Paste:=xlPasteValues
sh.PageSetup.PrintArea = Range("$A$1:$Q$52").Address
sh.PrintOut
End If

Do
Set FoundCell = Range("$K$3$K2000").FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
On Error Resume Next
FoundCell.Offset(0, -10).Copy
sh.Range("$S$4").PasteSpecial Paste:=xlPasteValues
sh.PageSetup.PrintArea = Range("$A$1:$Q$52").Address
sh.PrintOut
End If

Loop

End Sub

質問者からの補足コメント

• みなさま、ご協力ありがとうございました！！
  コードを以下に訂正してみたら、正常に動いてくれました！
  
  【旧】Set FoundCell = Range("$K$3:$K2000").Find(What:=1)
  【新】Set FoundCell = Sheets("データ").Range("$K$3:$K2000").Find(What:=1)
  
  シートの指定を入れたら、とりあえず動いてくれました（*^_^*）

  No.2の回答に寄せられた補足コメントです。 補足日時：2017/07/31 17:30

No.1 ベストアンサー 回答者： poco_2 回答日時： 2017/07/31 11:59

コードの中身はよく見てませんが、VBAの動く速さでプリントアウトが可能な環境ですか？

プリントアウトをブレークポイント等で止めながら動かすとどうなりますか？

この回答へのお礼

回答ありがとうございます！

プリントアウト自体は、VBAの動く速さで可能な環境です。
ブレークポイントで止めながらやってみたところ、必要枚数出力されました。
ちなみに、ステップインで動かしてみても正常に出力されました。

なぜかボタンで動かすと、②1)定期シートのS4セルがアクティブになったままとなり、①データシートに戻らず、2個目以降が出力されないまま終了してしまいます・・・

お礼日時：2017/07/31 13:14

No.2 回答者： fujillin 回答日時： 2017/07/31 14:09

こんにちは

ちゃんと見てはいませんが・・・

下の方のDoループの中の
＞Set FoundCell = Range("$K$3$K2000").FindNext(FoundCell)
もし、実際のコードが質問文でご提示のままだとすると、そこで実行が止まってませんか？
Rangeの範囲がおかしいので・・・

この回答へのお礼

回答ありがとうございます！

おそらくペーストした後に不手際で：が消えたのかもしれません(^_^;)
こちらの確認不足でお手を煩わせてすみません。。。

正しい処理の仕方なのか自信ないですが、続行してくれるようになりました！！
補足に追記させていただきますね！

お時間割いていただきありがとうございます！！！
もし、追記でおかしいところなどあればまた教えて下さると幸いです。

お礼日時：2017/07/31 17:26