実行時エラー438 オブジェクトはこのプロパティまたはメソッドをサポートしていません について

エクセルのVBAに関する質問です。

"リスト"というシートに部品番号と枚数を入力し、実行すると「部品番号」欄と同じ名前のシートを「枚数」欄に入力された枚数分印刷するというマクロを作ろうとしています。
画像のファイルで説明すると、部品番号欄にAと入力し、枚数欄に1と入力すると、Aというシートを1枚印刷する、というような作業です。同様に、Bを2枚、Cは0枚、Dは1枚印刷したいです。枚数はその都度変わります。構文は以下の通りです。


Sub 一括印刷()
Range("A2").Select

Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
Exit Do
End If

Dim a As String
a = Sheets("リスト").Selection.Value
Sheets(a).PrintOut Copies:=ActiveCell.Offset(0, 1)
Exit Sub

Loop

End Sub


プログラムの意図としては、
①A2セルを選択後、一行下のセルを選択する。
②”a”を"リスト"というシートの現在選択中のセルの値を同じ値に定義付ける。
③"a"と同じ名前のシートを、現在選択している一つ右隣のセルの値の枚数分印刷する。
④現在選択しているセルの一行下のセルを選択し、③を行う。
⑤セルが空白になるまで③～④を繰り返す。

という流れです。しかし、
a = Sheets("リスト").Selection.Value
の所で、「実行時エラー438　オブジェクトはこのプロパティまたはメソッドをサポートしていません」というエラーが出ます。このエラーの原因が分かりません。
もしお分かりになるようでしたら教えて頂きたいです。
又、このプログラムじゃなくても他の方法で実行できるよ、という案がありましたら教えて頂けると尚ありがたいです。
宜しくお願い致します。

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2021/07/06 14:46

こんにちは

このエラーは、エラーコメントにある通り
Sheets("リスト")にはSelectionが無いとこを示しています。
コードを拝見する限り
a = Selection.Value　や
a = ActiveCell.Value　で良いように思います。

＞他の方法で
For Eachを使用する方法で

Dim r As Range
On Error Resume Next
For Each r In Sheets("リスト").Range("A2", Sheets("リスト").Cells(Rows.Count, "A").End(xlUp))
If r.Value <> "" Then
Sheets(r.Value).PrintOut Copies:=r.Offset(0, 1).Value
End If
Next
End Sub

On Error Resume Nextは（少し乱暴ですが）エラー回避用です
本来は、 If r.Value <> "" 部分で　シート名　検証やB列の数値検証を入れた方が良いと思います。

この回答へのお礼

ご回答ありがとうございます。
For Eachを使用した方法で見事に実現することが出来ました。
早急なご回答ありがとうございました！
とても助かりました。感謝しております。

お礼日時：2021/07/06 15:17