A列に入力した数値順にB列の値を別シートに貼り付けたい

Question

A列に入力した数値順にB列の値を別シートに貼り付けたいです。

マクロで、複数ある物品の製造番号を転記するための入力シートを作成しています。
納入品リストの中には製造番号があるもの、ないものが混在しているため、
以下の例のように納入品リストを貼り付ける「シートA」から製造番号があるものを抽出して、C列の数量分だけ出力用シート「シートB」に貼り付けたいと考えています。

[シートA]

（A列）並べ替え順	（B列）品名	（C列）数量
	物品A
3	物品B	3
	物品C
1	物品D	1
	物品E
2	物品F	3

↓
[シートB]

（A列）品名	（B列）製造番号
物品D
物品F
物品F
物品F
物品B
物品B
物品B

試したこと

現在、[シートA]のA列が「１」の場合に、シートBに貼り付ける（A列に「1」があるものをC列の数だけ貼り付ける）ことまではできていますが、数字の並び順となるとどうしたらいいのかわからなくなっています。

該当のソースコード

Const 設定区分列 As Integer = 1
Const 繰返数列 As Integer = 11
Const 書込開始行 As Integer = 3
Const 製番表 As String = "製番表作成準備"

数量 = Cells(Rows.Count, 11).End(xlUp).Offset(1).Row

    書込中行 = 書込開始行    
    For i = 1 To 数量
        If Cells(i, 設定区分列) = 1 Then
            For j = 1 To Cells(i, 繰返数列)
                Sheets(製番表).Cells(書込中行, 2) = Cells(i, 2)
                書込中行 = 書込中行 + 1
            Next j
        End If
    Next i

補足情報（FW/ツールのバージョンなど）

EXCEL2010

Answer 1

今のコードを活かすのであれば、A列の並べ替え順を1から順次検索する処理を追加すれば簡単かと思います。
以下はサンプルですが動作未確認です。

Const 設定区分列 As Integer = 1
Const 繰返数列 As Integer = 11
Const 書込開始行 As Integer = 3
Const 製番表 As String = "製番表作成準備"

Dim 並べ替え順 As Integer
Dim 並べ替え順最大値 As Integer

数量 = Cells(Rows.Count, 11).End(xlUp).Offset(1).Row

書込中行 = 書込開始行    
並べ替え順最大値 = Application.WorksheetFunction.Max("A:A")

For 並べ替え順=1 To 並べ替え順最大値
	For i = 1 To 数量
		If Cells(i, 設定区分列) = 並べ替え順 Then
			For j = 1 To Cells(i, 繰返数列)
				Sheets(製番表).Cells(書込中行, 2) = Cells(i, 2)
				書込中行 = 書込中行 + 1
			Next j
		End If
	Next i
Next

ただし毎回先頭行から見に行くので遅いかもしれません。

Comments

[miyako123]

早速の回答ありがとうございました！
ただ、実行したところ、エラーが発生してしまいましたので、ご報告させていただきます・・・
[エラーメッセージ]
実行時エラー'1004'
WorksheetFuntionクラスのMaxプロパティを取得できません。

以上です。
よろしくお願いします。

[ttyp03]

コピペミスでしょうか。
×WorksheetFuntion
○WorksheetFunction

[miyako123]

エラーメッセージの打ち間違いで、マクロ自体は

並べ替え順最大値 = Application.WorksheetFunction.Max("A:A")

と記載しているので、コピペミスではないようです。

[miyako123]

並べ替え順最大値 = Application.WorksheetFunction.Max("A:A")
の、（）内を
Max(Range("A:A"))
と書き換えたところ、無事に動きました！

勉強になりました、ありがとうございました！

[ttyp03]

え、なんでだろ。
Applicationから順次打ち込んでいって、Function.まで打ったときにMaxって一覧にないでしょうか？
Excel2010は対応しているはずなんだけど。

もしこの方法が解決しない場合、以下でも対処できますので。
・別の方法で最大値を求める
・最大値がわかっているなら固定値にする
・とりあえず無駄にループがまわるが1000とか大きい値にしておく

[ttyp03]

あ、それか･･･。Range("A:A")
すみません、中途半端な回答で。

[miyako123]

いえいえ！
瑣末なことです！
本当にありがとうございました！
またご縁がありましたら、よろしくお願いします♪