Упростить код

[and150382]

Как можно упростить данный код

Private Sub CommandButton6_Click()
Sheets("Перекуры").Select
    ActiveWindow.SmallScroll Down:=-15
    Sheets("Перекуры").Select
    Sheets("Перекуры").Unprotect "6161" ' временно снимаем защиту
   ' ActiveSheet.Unprotect
    
    ActiveWindow.SmallScroll Down:=-9
    Range("B3:B42").Select
    Selection.ClearContents
    Range("D3:D42").Select
    Selection.ClearContents
    Range("F3:F42").Select
    Selection.ClearContents
    Range("H3:H42").Select
    Selection.ClearContents
    Range("J3:J42").Select
    Selection.ClearContents
    Range("L3:L42").Select
    Selection.ClearContents
    Range("N3:N42").Select
    Selection.ClearContents
    Range("P3:P42").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 2
    Range("R3:R42").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 1
    Range("B3").Select
    Sheets("Перекуры").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
        Sheets("Перекуры").Protect "6161" ' ставим защиту обратно
        
    Sheets("База").Select
    ActiveWindow.SmallScroll Down:=-12
    Sheets("База").Select
    Sheets("База").Unprotect "6161" ' временно снимаем защиту
    'ActiveSheet.Unprotect
    Range("B10:Q140").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Selection.ClearContents
    'убираем заливку
    Range("C10:C140").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    ActiveWindow.SmallScroll Down:=-147
    Range("C10").Select
    Sheets("База").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
      Sheets("База").Protect "6161" ' ставим защиту обратно
        
   'сохранить как....
  Range("P1").Select
  ActiveWorkbook.SaveAs Filename:= _
      "C:\Documents and Settings\Admin\Рабочий стол\ " & Left(Now, 10) & ".xlsm", _
      FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

[EducatedFool]

Примерно так:

Private Sub CommandButton6_Click()
    
    With Sheets("Перекуры")
        .Unprotect "6161"    ' временно снимаем защиту

        .Range("B3:B42").ClearContents
        .Range("D3:D42").ClearContents
        .Range("F3:F42").ClearContents
        .Range("H3:H42").ClearContents
        .Range("J3:J42").ClearContents
        .Range("L3:L42").ClearContents
        .Range("N3:N42").ClearContents
        .Range("P3:P42").ClearContents
        .Range("R3:R42").ClearContents

        .Protect "6161"    ' ставим защиту обратно
    End With

    With Sheets("База")
        .Unprotect "6161"    ' временно снимаем защиту

        .Range("B10:Q140").ClearContents
        .Range("C10:C140").Interior.ColorIndex = 0    'убираем заливку

        .Protect "6161"    ' ставим защиту обратно
    End With

    Filename$ = "C:\Documents and Settings\Admin\Рабочий стол\ " & Format(Now, "DD.MM.YYYY HH-NN-SS") & ".xlsm"
    
    ActiveWorkbook.SaveAs Filename$, xlOpenXMLWorkbookMacroEnabled

End Sub

[and150382]

Спасибо EducatedFool , как всегда выручил!!!!

[nerv]

еще так можно

.Range("B3:B42").ClearContents
.Range("D3:D42").ClearContents
.Range("F3:F42").ClearContents
.Range("H3:H42").ClearContents
.Range("J3:J42").ClearContents
.Range("L3:L42").ClearContents
.Range("N3:N42").ClearContents
.Range("P3:P42").ClearContents
.Range("R3:R42").ClearContents

.Range("B3:B42,D3:D42,F3:F42,H3:H42,J3:J42,L3:L42,N3:N42,P3:P42,R3:R42").ClearContents

только правильнее циклом

[IgorGO]

for c = 2 to 18 step 2
  cells(3,c).resize(40,1).ClearContents
next

[and150382]

Спасибо всем! А скажите, если файл с таким именем при сохранении уже существует, то появляется сообщение типа заменить его. При нажимании на любую кнопку выдает ошибку и подсвечивает

Range("P1").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Admin\Рабочий стол\ " & Left(Now, 10) & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroE nabled, CreateBackup:=False

Как сделать чтобы при нажатии на кнопки всё работало?

[EducatedFool]

Как сделать чтобы при нажатии на кнопки всё работало?

а вы не пробуете задавать вопросы Яндексу?

на этот вопрос на форуме отвечали десятки раз...

    Filename$ = "C:\Documents and Settings\Admin\Рабочий стол\ " & Format(Now, "DD.MM.YYYY HH-NN-SS") & ".xlsm"

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename$, xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True

[and150382]

В вашем коде ругается на Filename$

[DiemonStar]

Filename$ = "C:\Documents and Settings\Admin\Рабочий стол\_" & Format(Now, "DD.MM.YYYY HH-NN-SS") & ".xlsm"

пробел уберите.

[and150382]

вот какую ошибку выдаёт