Дайте это. Обновите свой диапазон, где указано
Option Explicit
Public Sub ConvertValuesToRows()
Dim destRange As Range, rng As Range, srcRange As Range
Dim i As Long, RowCount As Long
' Update this to your source range
With Sheet1
Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
End With
With rng
For i = .Rows.Count To 1 Step -1
If .Cells(i, 2) > 1 Then
RowCount = .Cells(i, 2) - 1
.Range(.Cells(i, 1), .Cells(i, .Columns.Count)).Resize(RowCount).Insert shift:=xlDown
Set srcRange = Range(.Cells(i, 1), .Cells(i, rng.Columns.Count))
Set destRange = Range(srcRange, srcRange.Offset(RowCount, 0))
srcRange.AutoFill Destination:=destRange, Type:=xlFillCopy
.Cells(i, 3) = 1
srcRange.Columns(3).AutoFill Destination:=destRange.Columns(3), Type:=xlFillSeries
End If
Next i
End With
End Sub