Sub COPY_CT()
Dim LastRow As Long, Rw As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 
With Sheets("УЧЕТ")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 7 To LastRow
If Cells(i, 1) = "4К" And Cells(i, 5) = "СТ" Then
Range(Cells(i, 1), Cells(i, 52)).COPY
 .Cells(Rw, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats'Вставить вместо "COPY" режим "Значение и форматы чисел (3)" как на рисунке
Rw = Rw + 1
End If
Next
End With
Application.ScreenUpdating = True

Sub BoldSum()
Dim BoldSum As Double
Dim NoBoldSum As Double
Dim i As Long
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, 5).End(xlUp).Row
  BoldSum = 0
  NoBoldSum = 0
  For i = 5 To iLastRow
    If IsNumeric(Cells(i, 5)) = True Then
       If Cells(i, 5).Font.Bold = True Then
         BoldSum = BoldSum + Cells(i, 5)
       Else
         NoBoldSum = NoBoldSum + Cells(i, 5)
       End If
   End if
  Next
    Cells(i, 6) = BoldSum
     
    Cells(i, 6).NumberFormat = "#,##0.00"
End Sub