Sub Печать()

Sheets("ФормаП").PrintOut preview:=True
Лист1.Range("D2") = Лист1.Range("D2") + 1
Call Add_to_archive
End Sub

Sub Add_to_archive()
Dim arr(1 To 1, 1 To 8)
Dim lRow&
With Worksheets("ФормаП")
  arr(1, 1) = .Range("J7")
  arr(1, 2) = .Range("D7")
  arr(1, 3) = .Range("C9")
  arr(1, 4) = .Range("C10")
  arr(1, 5) = .Range("D25")
  arr(1, 6) = .Range("D26")
  arr(1, 7) = .Range("D27")
  arr(1, 8) = .Range("D28")
End With
With Worksheets("Архив")
  lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  lRow = IIf(lRow < 3, 3, lRow)
  .Cells(lRow, 1).Resize(, 8) = arr
End With
End Sub