長いマクロ文をdo whileで簡潔にするには

質問

お得意先ごとに月末に一括で請求書を自動作成・保存・印刷するマクロを作りました。しかし、あまりにもマクロ文が長いので短くしたいと考えています。
現状、シート名「今月処理件数」上のマクロ”請求書一括印刷”を押すと該当月の一社ごとの売上が保存され、請求書作成、印刷まで実行されます。このシートのA列A2からその下に該当月に取引のあった会社コードが入ります。A71を最終行としています。A2がkprint1～A71がkprint70までのマクロ文を作っています。
「今月処理件数」上のマクロ”請求書一括印刷”及び"kprint1～kprint70"のマクロ文を　do while か for next文で書き換えて短くする方法はありますでしょうか。
※シート名「作業データ1」及び「作業データ3」は一時作業シートです。他のシートは請求書保存、会社ごとの売掛情報保存に必要なシートです。
Sub 請求書一括印刷()
'実際にはkprint1～kprint70までありますが、kprint3までで割愛しています。
Select Case True
Case Range("a2") = ""
MsgBox "印刷データがありません。"
Case Range("a3") = ""
Call kprint1
MsgBox "印刷しました。"
Case Range("a4") = ""
Call kprint1
Call kprint2
MsgBox "印刷しました。"
Case Range("a5") = ""
Call kprint1
Call kprint2
Call kprint3
MsgBox "印刷しました。"
End Select
End Sub

kprint1からkprint70まで作成しています。kprint1は「今月処理件数」のA2の会社コードの処理です。kprint2はA3の会社コードの処理、それ以降、A71までの会社コートを想定してkprint70まで作っています。
Sub kprint1()
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("請求書データベース").Unprotect
ThisWorkbook.Worksheets("今月処理件数").Unprotect

Worksheets("今月処理件数").Range("A2").Copy Worksheets("請求書データベース").Range("AD1")
Range("D2").Value = "印刷済み"
Call 条件フィルタ2 '請求書データベースA列(会社コード)を解除する
Call 条件フィルタ1 '請求書データベースAD1に入力された会社コードを使ってA列（会社コード）からAD1の会社コードを取得する

ThisWorkbook.Worksheets("今月処理件数").Protect
ThisWorkbook.Worksheets("請求書データベース").Protect AllowFiltering:=True
ThisWorkbook.Worksheets("請求書データベース").Unprotect
Range("A1").Select
Selection.CurrentRegion.Select
'アクティブシートの切り替え
ActiveWorkbook.Worksheets("作業データ1").Activate
'アクティブシートの図形・画像を全て削除
ActiveSheet.DrawingObjects.Delete
'アクティブシートの内容を全て削除
ActiveSheet.Cells.Clear
'アクティブシートのコメントを全て削除
ActiveSheet.Cells.ClearComments
Sheets("請求書データベース").Select
Selection.Copy
Sheets("作業データ1").Activate
Range("A1").Select
ActiveSheet.Paste
Call 売上一覧入力　　'請求書データベースのフィルタ検索結果の可視行をすべて作業データ1に貼り付ける
Call 売上集計保存2　 '一時作業シート「作業シート3」の内容を「売上集計」に貼り付ける　
Sheets("請求書データベース").Select
ActiveSheet.Protect AllowFiltering:=True

Sheets("請求書3").Visible = True
Sheets("請求書3").Select
Call print_nohin1
Sheets("請求書3").Visible = False
Sheets("今月処理件数").Select
Application.ScreenUpdating = True
End Sub

上記"kprint1"に出てくる、callステートメントのマクロの内容は以下の通りです。

Sub 条件フィルタ1()
Worksheets("請求書データベース").Select
ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:=Range("AD1")　'AD1の値でA列の会社コードにフィルターをかける
End Sub

Sub 条件フィルタ2()
Worksheets("請求書データベース").Select
ActiveSheet.Range("$A$1").AutoFilter Field:=1　'A列の会社コードのフィルター解除
End Sub

Sub 売上一覧入力()
' 売上一覧入力 Macro'
ActiveWorkbook.Worksheets("作業データ1").Activate
GYOU = Sheets("売上一覧表").Range("B65536").End(xlUp).Offset(1, 0).Row '「売上一覧表」には会社コード、会社名、売上金額、入金情報がコピーされる。
Sheets("売上一覧表").Cells(GYOU, 1).Value = Range("X2").Value
Sheets("売上一覧表").Cells(GYOU, 2).Value = Range("P2").Value
Sheets("売上一覧表").Cells(GYOU, 3).Value = Range("C2").Value
Sheets("売上一覧表").Cells(GYOU, 4).Value = Range("Q2").Value
Sheets("売上一覧表").Cells(GYOU, 5).Value = Range("R1").Value
Sheets("売上一覧表").Cells(GYOU, 6).Value = Range("S1").Value
Sheets("売上一覧表").Cells(GYOU, 7).Value = Range("T1").Value
Sheets("売上一覧表").Cells(GYOU, 8).Value = Range("U1").Value
Sheets("売上一覧表").Cells(GYOU, 9).Value = Range("V1").Value
Sheets("売上一覧表").Cells(GYOU, 10).Value = Range("W1").Value
Sheets("売上一覧表").Cells(GYOU, 11).Value = Range("Y2").Value
End Sub

Sub 売上集計保存2()
'変数の宣言
Dim LstRow1 As Long
Dim LstRow2 As Long
'最終行の取得
Worksheets("作業データ3").Activate　'作業データ1の２行目から80行目までの内容をすべて、作業データ3の２行目に取得する。

LstRow1 = Worksheets("作業データ3").Cells(Rows.Count, 1).End(xlUp).Row
LstRow2 = Worksheets("売上集計").Cells(Rows.Count, 1).End(xlUp).Row

'タイトル行を除き、売上集計へコピー、貼り付け
Worksheets("作業データ3").Range("A2:ZM2").Copy
Worksheets("売上集計").Select
Worksheets("売上集計").Range("A" & LstRow2).Offset(1, 0).PasteSpecial xlPasteValues
Worksheets("今月処理件数").Select
End Sub

Sub print_nohin1()
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False　'請求書は繰越額や請求金額の数字だけなので、1ページのみの印刷
End Sub

回答No.1

HohoPapa · ベストアンサー

コードをざっくり眺める限り、シートが少なくとも
　請求書データベース
　今月処理件数
　作業データ1
　請求書3
　売上一覧表
　作業データ3
　売上集計
と７シートあり、それぞれのレイアウトがわからないのと、

Case Range("a2") = ""
や
Range("A1").Select
Range("D2").Value = "印刷済み"
といったコードでは、
どのブック、どのシートを指しているのかわかりません。

特に後者は、バグの温床になります。

更に、
Sub kprint2()
がポストされていないので
Sub kprint1()
と
Sub kprint2()
の比較ができません。

そのため、的を射ているかどうか怪しいですが
こんな感じにすればいいだろうと思います。

'Sub 請求書一括印刷()
' '実際にはkprint1～kprint70までありますが、kprint3までで割愛しています。
'　Select Case True
'　　Case Range("a2") = ""
'　　　MsgBox "印刷データがありません。"
’　　　略
'　　　Call KPprintSub(3)
'　　　MsgBox "印刷しました。"
'　End Select
'End Sub

'//---------------------------
'// 請求書一括印刷
'//---------------------------
Sub 請求書一括印刷()

　Dim RowCounter As Long

　RowCounter = 2
　If Cells(RowCounter, 1).Value = "" Then
　　MsgBox "印刷データがありません。"
　　Exit Sub
　End If

　Do
　　If Cells(RowCounter, 1).Value = "" Then Exit Sub
　　　Call KPprintSub(RowCounter - 1)
　　RowCounter = RowCounter + 1
　Loop

End Sub

'//---------------------------
'// KPprintSub　引数：RowNumは、印刷対象会社の行-1かな？？
'//---------------------------
Sub KPprintSub(RowNum As Long)
　Application.ScreenUpdating = False
　ThisWorkbook.Worksheets("請求書データベース").Unprotect
　ThisWorkbook.Worksheets("今月処理件数").Unprotect

　'Worksheets("今月処理件数").Range("A2").Copy _
　'　Worksheets("請求書データベース").Range("AD1")
　Worksheets("今月処理件数").Cells(RowNum + 1, 1).Copy _
　　Worksheets("請求書データベース").Range("AD1")

　Range("D2").Value = "印刷済み"　'///どのシート？

　'//////以下省略
　'-----------

End Sub

お礼

長い文章を精査いただき、ありがとうございます。ご提示いただいた、Sub 請求書一括印刷()　及びSub KPprintSub(RowNum As Long)を実行したところ、処理速度も速く請求書の一括保存・印刷が実行されました。

ご指摘いただいたRange("D2").Value = "印刷済み"はシート「今月処理件数」D2を指しています。ただし私の拙いマクロ文では、どのシートなのか指摘していませんね。なぜか、うまく動作はしていたのですが、バグの原因になるのですね。

印刷済みの表示は必須ではないので、今回のマクロ文では省きました。kprint1とkprint2の違う箇所は以下のマクロ文だけです。
Worksheets("今月処理件数").Range("A3").Copy Worksheets("請求書データベース").Range("AD1")

kprint3はA4、kprint4はA5の値をコピーするように指摘しているだけです。

うまく動作しているマクロ文は以下の通りです。誠にありがとうございます。m( _ _)m

Sub 請求書一括印刷()
Dim RowCounter As Long

RowCounter = 2
If Cells(RowCounter, 1).Value = "" Then
MsgBox "印刷データがありません。"
Exit Sub
End If

Do
If Cells(RowCounter, 1).Value = "" Then Exit Sub
Call KPprintSub(RowCounter - 1)
RowCounter = RowCounter + 1
Loop

End Sub

Sub KPprintSub(RowNum As Long)
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("請求書データベース").Unprotect
ThisWorkbook.Worksheets("今月処理件数").Unprotect

Worksheets("今月処理件数").Cells(RowNum + 1, 1).Copy _
Worksheets("請求書データベース").Range("AD1")

Call 条件フィルタ2
Call 条件フィルタ1

ThisWorkbook.Worksheets("今月処理件数").Protect
ThisWorkbook.Worksheets("請求書データベース").Protect AllowFiltering:=True

ThisWorkbook.Worksheets("請求書データベース").Unprotect

Range("A1").Select
Selection.CurrentRegion.Select

'アクティブシートの切り替え
ActiveWorkbook.Worksheets("作業データ1").Activate
'アクティブシートの図形・画像を全て削除
ActiveSheet.DrawingObjects.Delete
'アクティブシートの内容を全て削除
ActiveSheet.Cells.Clear
'アクティブシートのコメントを全て削除
ActiveSheet.Cells.ClearComments

Sheets("請求書データベース").Select
Selection.Copy
Sheets("作業データ1").Activate
Range("A1").Select
ActiveSheet.Paste

Sheets("請求書データベース").Select
ActiveSheet.Protect AllowFiltering:=True

Call 売上一覧入力
Call 売上集計保存2

Sheets("請求書データベース").Select
ActiveSheet.Protect AllowFiltering:=True

Sheets("請求書3").Visible = True
Sheets("請求書3").Select
Call print_nohin1

Sheets("請求書3").Visible = False
Sheets("今月処理件数").Select

Application.ScreenUpdating = True

End Sub