Sub tt()
    With Selection
        shIn_ = .Parent.Index
        ad_ = .Address
        nr_ = .Rows.Count
        .Copy
    End With
    With Sheets(shIn_ + 1)
        .Select
        Application.ScreenUpdating = 0
        With .Range(ad_)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
            For i = nr_ - 1 To 1 Step -1
                .Offset(i).Resize(1).EntireRow.Insert
            Next i
            .Offset(1, 16).Resize(1, 1).EntireColumn.Insert
            .Offset(, 17).Resize(nr_ * 2 - 1, 16).Copy
            .Offset(1, 1).Resize(1, 1).Select
        End With
        .PasteSpecial Format:=1, Link:=1, DisplayAsIcon:=True, IconFileName:=False
        .Range(ad_).Offset(, 17).Resize(nr_ * 2 - 1, 16).Clear
        Application.ScreenUpdating = 1
    End With
End Sub

Sub tt()
    Dim rSource As Range
    Set rSource = Sheets("ОДНОСТРОЧНЫЙ").Range("H13:AL27")
    With rSource
        Dim ad_ As String
        ad_ = .Address
        Dim nr_ As Long
        nr_ = .Rows.Count
    End With
     
    Dim rTarget As Range
    Set rTarget = Sheets("СУДОВОЙ").Range(ad_).Cells(1, 1)
     
    Application.ScreenUpdating = False
    Dim Application_Calculation As XlCalculation: Application_Calculation = Application.Calculation: Application.Calculation = xlCalculationManual
     
    Dim ys As Long, xs As Long, yt As Long, xw As Long
    For ys = 1 To rSource.Rows.Count
        xw = 16 + 1
        For xs = 1 To rSource.Columns.Count Step 16
            yt = yt + 1
            xw = xw - 1
            rSource.Cells(ys, xs).Resize(1, xw).Copy
            rTarget(yt, 1).PasteSpecial Paste:=xlPasteValues
            rTarget(yt, 1).PasteSpecial Paste:=xlPasteFormats
        Next
    Next
    Calculate
    Application.Calculation = Application_Calculation
    Application.ScreenUpdating = True
End Sub