こんなのではどうでしょうか?
初期設定のConst部を指定してください。
Sub sample()
'初期設定
Const 表1 = "A1" '表1の左上のセル(「ロット」の文字のセル)
Const 表2 = "D1" '表2の左上のセル(「仕込量(kg)」の結合セル範囲の左のセル)
Const 表2データ部 = "E4:L9" '表2のデータ(黄色)の部分のセル(クリアのため)
Dim r1 As Integer
Dim c1 As Integer
Dim r2 As Integer
Dim c2 As Integer
Dim r2ofs As Integer
Dim 仕込量 As Integer
Dim 数量 As Integer
Dim data As Integer
'表2クリア
Range(表2データ部).ClearContents
'注目点の初期位置に移動
r1 = Range(表1).Row '=r1+1-1(最初に数量を読み込むための移動を考慮)
c1 = Range(表1).Column + 1
r2 = Range(表2).Row + 2
c2 = Range(表2).Column - 1 '=c2+1-2(最初に仕込量を読み込むための移動を考慮)
'開始
Do
If 数量 = 0 Then
r1 = r1 + 1 '次の数量の行
If Cells(r1, c1) = 0 Then Exit Do '数量が無いなら終わり
数量 = Cells(r1, c1)
End If
If 仕込量 = 0 Then
c2 = c2 + 2 '次の仕込量の列
If Cells(r2, c2) = 0 Then Exit Do '仕込量が無いなら終わり
仕込量 = Cells(r2, c2)
r2ofs = 1 '表2の新しい列に書くため、行方向のr2からのオフセットを初期化
End If
Cells(r2 + r2ofs, c2) = Cells(r1, c1 - 1) ' ロットを表示
data = IIf(数量 <= 仕込量, 数量, 仕込量) '表示値を取得
Cells(r2 + r2ofs, c2 + 1) = data
仕込量 = 仕込量 - data
数量 = 数量 - data
r2ofs = r2ofs + 1
Loop
End Sub
仕込量(ピンク)の部分に入力があったら変更する場合です。
"E3:L3"は表示に合わせて変更してください。
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("E3:L3"), Target) Is Nothing Then
sample
End If
End Sub