ВСЕМ БОЛЬШОЕ ЗДРАВСТВУЙТЕ!
Смастерил только-что маленький код, все работает.
Если можно что-нибудь подправить, подправьте, пожалуйста, укажите на ошибки.
Sub NovZapis()
Dim iLastRow As Long
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, 6).End(xlUp).Row
Cells(iLastRow, 1).EntireRow.Copy
Cells(iLastRow + 1, 1).EntireRow.Select
Selection.Insert Shift = xlDown
Selection.ClearContents
Cells(iLastRow + 1, 1).FormulaR1C1 = "=MAX(R2C1:R[-1]C1)+1"
Cells(iLastRow + 1, 2).FormulaR1C1 = 1
Cells(iLastRow + 1, 3).FormulaR1C1 = 1
Cells(iLastRow + 1, 4).FormulaR1C1 = "=MAX(R2C4:R[-1]C4)+1"
Cells(iLastRow + 1, 5).FormulaR1C1 = 1
Cells(iLastRow + 1, 6).FormulaR1C1 = "=R[-1]C6"
Cells(iLastRow + 1, 1).EntireRow.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(iLastRow + 1, 7).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
СПАСИБО!
С ув. Vovan/
Смастерил только-что маленький код, все работает.
Если можно что-нибудь подправить, подправьте, пожалуйста, укажите на ошибки.
Sub NovZapis()
Dim iLastRow As Long
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, 6).End(xlUp).Row
Cells(iLastRow, 1).EntireRow.Copy
Cells(iLastRow + 1, 1).EntireRow.Select
Selection.Insert Shift = xlDown
Selection.ClearContents
Cells(iLastRow + 1, 1).FormulaR1C1 = "=MAX(R2C1:R[-1]C1)+1"
Cells(iLastRow + 1, 2).FormulaR1C1 = 1
Cells(iLastRow + 1, 3).FormulaR1C1 = 1
Cells(iLastRow + 1, 4).FormulaR1C1 = "=MAX(R2C4:R[-1]C4)+1"
Cells(iLastRow + 1, 5).FormulaR1C1 = 1
Cells(iLastRow + 1, 6).FormulaR1C1 = "=R[-1]C6"
Cells(iLastRow + 1, 1).EntireRow.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(iLastRow + 1, 7).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
СПАСИБО!
С ув. Vovan/