Sub azaz()EndRow = ThisWorkbook.Sheets("Base").Cells(2, 1).End(xlDown).Rowf = 1For x = 2 To EndRow p1 = Cells(x, 13).Value If Cells(x, 13) > 1 Then c = p1 - 1 Row.Select Selection.Copy Selection.Insert Shift:=xlDown d = x + 1 For Each cell In Range(Cells(d, 13), Cells(x, 13)) Cells.Value = c Next cell2: End If Cells(x, 13).Select If c > 1 Then GoTo 1 Next x 1: c = Cells(x, 13).Value - 1 Row.Select Selection.Copy Selection.Insert Shift:=xlDown d = x + 1 + f For Each cell In Range(Cells(d, 13), Cells(x, 13)) Cells.Value = c Next cell f = f + 1 GoTo 2 End Sub
For Each cell In Range(Cells(d, 13), Cells(x, 13)) Cells.Value = c Next cell
Cell.Value = c
[Sub azaz()EndRow = ThisWorkbook.Sheets("Base").Cells(2, 1).End(xlDown).Rowf = 1For x = 2 To EndRow p1 = Cells(x, 13).Value If Cells(x, 13) > 1 Then c = p1 - 1 Rows(ActiveCell.Row).Select Selection.Copy Selection.Insert Shift:=xlDown d = x + 1 For Each Cell In Range(Cells(d, 13), Cells(x, 13)) Cell.Value = c Next Cell2: End If Cells(x, 13).Select If c > 1 Then GoTo 1 Next x 1: c = Cells(x, 13).Value - 1 Rows(ActiveCell.Row).Select Selection.Copy Selection.Insert Shift:=xlDown d = x + 1 + f For Each Cell In Range(Cells(d, 13), Cells(x, 13)) Cell.Value = c Next Cell f = f + 1 GoTo 2 End Sub/code]
Sub azaz()EndRow = ThisWorkbook.Sheets("Base").Cells(2, 1).End(xlDown).Rowf = 1N_Row = 24:If Cells(N_Row, 1) = "" Then GoTo 3 p1 = Cells(N_Row, 13).Value If Cells(N_Row, 13) > 1 Then c = p1 - 1 Rows(ActiveCell.Row).Select Selection.Copy Selection.Insert Shift:=xlDown d = N_Row + 1 For Each Cell In Range(Cells(d, 13), Cells(N_Row, 13)) Cell.Value = c Next Cell2: End If Cells(N_Row, 13).Select If c > 1 Then GoTo 1 If Cells(N_Row, 1) = "" Then GoTo 3 N_Row = N_Row + 1 GoTo 41: c = p1 - 1 Rows(ActiveCell.Row).Select Selection.Copy Selection.Insert Shift:=xlDown g = g + 1 d = N_Row + 1 + f For Each Cell In Range(Cells(d, 13), Cells(N_Row, 13)) Cell.Value = c Next Cell f = f + 1 GoTo 23:End Sub
Sub qq()Dim i As Integer, j As Integer, n As Integern = Cells(2, 1).End(xlDown).RowFor i = 2 To n For j = 1 To Cells(i, 13) - 1 n = n + 1 Range(Cells(n, 1), Cells(n, 16)) = Range(Cells(i, 1), Cells(i, 16)).Value Next jNext iRange(Cells(2, 13), Cells(n, 13)) = 1End Sub