Подправить сохранение диапазона

[staniiislav]

Доброго времени суток, Ув. Форумчане.
Помогите пожалуйста до ровнять напильником вот этот код:

Sub SaveCells()
Dim base As String, iyear As String, idate As Date, adr As String, Fname As String
Dim Wsh As Worksheet, wb As Object, x, i As Long, fg_ As String, fm_ As String
Application.ScreenUpdating = False
Set Wsh = ThisWorkbook.ActiveSheet: iyear = CStr(Year([C4])): idate = [C4]
If MsgBox("Сохранить в БД?", vbYesNo, "Подтверждение") = vbYes Then

Workbooks.Open (ThisWorkbook.Path & "\Архив\БД.xlsm"): On Error GoTo Handler
With Workbooks("БД.xlsm").Sheets("base")
    .Unprotect "0000"
    x = .Range("B1:DO" & .cells(Rows.Count, 3).End(xlUp).Row).Value
    For i = 4 To UBound(x, 1) Step 49
        If x(i, 2) = idate And x(i, 1) = Wsh.[b4] Then
            If MsgBox("Совпадение даты. Заменить в БД?", vbYesNo) = vbYes Then
                Wsh.Range("A4:DH52").Copy .Range("A" & i)
            End If: Exit For
        End If
    Next i
    If UBound(x, 1) = 1 Then
        Wsh.Range("A4:DH52").Copy .Range("A4")
    ElseIf i > UBound(x, 1) Then
        Wsh.Range("A4:DH52").Copy .Range("A" & i)
    End If
     ActiveSheet.Protect "znwf33gnbntrf21", Contents:=True, Scenarios:=True, AllowFiltering:=True
    On Error GoTo 0
End With
With Workbooks("БД.xlsm"): .Close True: End With: End If

If MsgBox("Сохранить в Архив?", vbYesNo, "Подтверждение") = vbYes Then
    Fname = ThisWorkbook.Path & "\Архив"
    On Error Resume Next
    MkDir Fname
    fg_ = Format(idate, "yyyy"): fm_ = Format(idate, "mmmm")
    If idate <> Empty Then
        If Wsh.Visible = -1 Then
            Wsh.Copy
            Set wb = ActiveWorkbook
            With wb
                
                .Sheets(1).Shapes(1).Delete
                ActiveSheet.Protect Password:="znwf33gnbntrf21", Contents:=True, Scenarios:=True, AllowFiltering:=True
                .SaveAs Fname & "\" & fg_ & "\" & fm_ _
                          & "\" & Wsh.Name & " (" & idate & ").xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                .Close
            End With
        End If
        MsgBox "Лист " & Wsh.Name & " в виде файла сохранен в папку " & Fname & "\" & fg_ & "\" & fm_
    End If
End If
Application.ScreenUpdating = True
Exit Sub
Handler:
MsgBox "Лист с таким годом не найден" & vbCrLf & Err.Description
End Sub

там где выделено красным, нужно немного подкорректировать. Необходимо чтобы копировались значения и форматы ячеек, а не все полностью.
Заранее огромное спасибо

[IgorGO]

Станислав, открою Вам одну страшную тайну (только это между нами...). если записать свои действия макрорекордером, а потом проанализировать записанное, то можно гораздо реже обращаться сюда с вопросами.

Wsh.Range("A4:DH52").Copy 
.Range("A" & i).PasteSpecial Paste:=xlPasteValues
.Range("A" & i).PasteSpecial Paste:=xlPasteFormats

примера для одной строчки достаточно?

[staniiislav]

Сообщение от IgorGO

Станислав, открою Вам одну страшную тайну (только это между нами...). если записать свои действия макрорекордером, а потом проанализировать записанное, то можно гораздо реже обращаться сюда с вопросами.

Wsh.Range("A4:DH52").Copy 
.Range("A" & i).PasteSpecial Paste:=xlPasteValues
.Range("A" & i).PasteSpecial Paste:=xlPasteFormats

примера для одной строчки достаточно?

конечно достаточно, спасибо большое!
Я знаю про макроредактор, и постоянно пользуюсь им, просто на форуме еще могут помочь написать код, который макроредактор не сделает (((
Спасибо IgorGO!