Ging mir ein wenig auf den Zeiger. ;)

Option Explicit
  
Public Sub Test()
  
  Dim rngData As Excel.Range
  
  With Worksheets("Tabelle1")
'   [A]    [B]
'1: Art ¦ Menge
'  -----+------
'2:  1  |  34
'3:  2  |   7
'4:  3  |   7
'5:  4  |  18
    With .Range("B2") '< erste "Daten"-Zelle in Spalte Menge
      'Bereich mit Daten in Spalte B ab Zeile 2 ermitteln
      Set rngData = .Worksheet.Range(.Cells(1), .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp))
      If rngData.Row < .Row Then
        Call MsgBox("Keine Daten zum Verarbeiten vorhanden!", vbExclamation)
        Exit Sub
      End If
    End With
  End With
  
  Dim retVal  As Variant
  Dim k_max   As Long 'maximale Menge k
  Dim k       As Long 'Menge k
  Dim n       As Long 'Anzahl (Zeilen)
  
  Do
    retVal = Application.InputBox("Maximal zulässige Menge (z.B. 5, 12 oder 42):", "Maximal Menge eingeben", 21, Type:=1)
    If VarType(retVal) = vbBoolean Then
      Exit Sub
    ElseIf 0 >= retVal Or retVal > &H7FFFFFFF Then
      Call MsgBox("Nur Zahlen zwischen 1 und 2.147.483.647 erlaubt.", vbExclamation)
    ElseIf (retVal \ 1) <> retVal Then
      Call MsgBox("Nur ganze Zahlen erlaubt!", vbExclamation)
    Else
      Exit Do
    End If
  Loop
  
  k_max = retVal
  
  Dim i As Long
  'von unten nach oben (!)
  For i = rngData.Cells.Count To 1 Step -1
    With rngData.Cells(i)
      k = .Value          'Menge k
      n = (k \ k_max + 1) 'Anzahl (Zeilen)
      If n > 1 Then
        'neue Zeilen einfügen
        Call .Offset(1).Resize(n - 1).EntireRow.Insert(xlShiftDown)
        'Spalte [Art]: übertrage den Wert in neue Zeilen
        .Resize(n).Offset(0, -1) = .Offset(0, -1)
        'Spalte [Menge]: setze neue Werte
        .Resize(n).Value = k \ n
        'Spalte [Menge]: ggf. Rest aufteilen
        For k = 1 To (k Mod n)
          .Offset(k - 1).Value = .Offset(k - 1).Value + 1
        Next
      End If
    End With
  Next
  
  Call MsgBox("Fertig.", vbInformation)
  
End Sub