Sub Цена2()    ' Копирование Цена2
Dim r As Range
With Range("D4:D17")
    .Interior.Color = xlNone
    .Font.ColorIndex = xlAutomatic
    For Each r In .Cells
        If Len(r(1, 2)) Then r(1, 2).Copy r
    Next
End With
End Sub

Sub Цена3()    ' Копирование Цена3
Dim r As Range
With Range("D4:D17")
    .Interior.Color = xlNone
    .Font.ColorIndex = xlAutomatic
    For Each r In .Cells
        If Len(r(1, 3)) Then r(1, 3).Copy r
    Next
End With
End Sub

Sub Цена2()    ' Копирование Цена2
Dim r As Range
With Range("D4:D17")
    .Interior.Color = xlNone
    .Font.ColorIndex = xlAutomatic
    For Each r In .Cells
        If Len(r(1, 2)) Then
            r(1, 2).Copy
            r.PasteSpecial xlPasteValues
            r.PasteSpecial xlPasteFormats
        End If
    Next
End With
Application.CutCopyMode = False
End Sub

Sub Цена3()    ' Копирование Цена3
Dim r As Range
With Range("D4:D17")
    .Interior.Color = xlNone
    .Font.ColorIndex = xlAutomatic
    For Each r In .Cells
        If Len(r(1, 3)) Then
            r(1, 3).Copy
            r.PasteSpecial xlPasteValues
            r.PasteSpecial xlPasteFormats
        End If
    Next
End With
Application.CutCopyMode = False
End Sub