VBA Macro which create new lines by codes

[p45cal]

Alan, no I'm not getting notifications of responses…

This one tries to preserve the leading zeroes (even if there are more than one) being guided by the length of the string directly before the hyphen:

Sub blah()
Dim Results(), Destn As Range, rngSce As Range, Sce, j, Count, SceRw, a, itm, b, Padding, i, Cde, k
Set Destn = Sheets("New").Range("A1")    'top left cell of where the results will go.
Set rngSce = Sheets("Old").Range("A1").CurrentRegion
Sce = rngSce.Value
For j = 1 To 2    '2 loops, first time to get a count of rows needed, second time to populate array
  Count = 1
  For SceRw = 2 To UBound(Sce)
    a = Split(Application.Trim(Sce(SceRw, 3)), ";")
    For Each itm In a
      b = Split(Application.Trim(itm), "-")
      If UBound(b) > 0 Then 'there's a hyphen:
        Padding = Len(Application.Trim(b(0)))
        For i = CLng(b(0)) To CLng(b(1))
          Count = Count + 1
          If j > 1 Then
            Cde = Format(i, Application.Rept(0, Padding))
            For k = 1 To UBound(Sce, 2)
              Results(Count, k) = Sce(SceRw, k)
            Next k
            Results(Count, 3) = Cde
          End If
        Next i
      Else 'there's no hyphen:
        Count = Count + 1
        If j > 1 Then
          Cde = Application.Trim(b(0))
          For k = 1 To UBound(Sce, 2)
            Results(Count, k) = Sce(SceRw, k)
          Next k
          Results(Count, 3) = Cde
        End If
      End If
    Next itm
  Next SceRw
  If j = 1 Then    'create new array
    ReDim Results(1 To Count, 1 To UBound(Sce, 2))
    For k = 1 To UBound(Sce, 2)    'populate top row of headers:
      Results(1, k) = Sce(1, k)
    Next k
  End If
Next j
Destn.Resize(UBound(Results)).Offset(, 2).NumberFormat = "@"    'format 3rd column as Text
Destn.Resize(UBound(Results), UBound(Results, 2)).Value = Results
End Sub