Remplacer ligne macro par une autre

Bonjour le forum

Je voudrais remplacer cette ligne macro par une autre dmais qui fait la même chose dans le module ci-dessous

Merci à vous

ActiveSheet.Protect UserInterfaceOnly:=True

Sub Tri()
Dim J As Long, LastRow As Long
  ActiveSheet.Unprotect
  Application.ScreenUpdating = False

  If ActiveSheet.Name = "aaa" Then
    LastRow = Range("J" & Rows.Count).End(xlUp).Row

    Range("A3:K" & LastRow).Sort Key1:=Range("J3"), Order1:=xlAscending, Header:=xlNo, _
                               MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  Else
    LastRow = Range("A" & Rows.Count).End(xlUp).Row

    Range("A3:F" & LastRow).Sort Key1:=Range("F3"), Order1:=xlAscending, Header:=xlNo, _
                               MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  End If
  With Rows("3:" & LastRow)
    .RowHeight = 50
    .AutoFit
  End With

  For J = 3 To LastRow
    If Rows(J).RowHeight <= 18 Then Rows(J).RowHeight = 20
  Next J
  Application.Goto Range("A1"), Scroll:=True
Application.EnableEvents = True
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Bonjour al87,

je ne suis pas certaine d'avoir compris la demande,

si c'est pour ajouter un mot de passe,

ActiveSheet.Protect Password:="zzzz", UserInterfaceOnly:=True

ps/

voici un exemple pour les autres arguments,

Sub Protege()
'protection de la feuille active
With ActiveSheet
'permet filtre et grouper lignes et colonnes
    .EnableAutoFilter = True
    .EnableOutlining = True

    'pour les options de protection que vous ne désirer pas autoriser: changer True pour False
    .Protect Password:="zzz", _
        DrawingObjects:=True, _
        Contents:=True, _
        Scenarios:=True, _
        AllowFormattingCells:=True, _
        AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, _
        AllowInsertingColumns:=True, _
        AllowInsertingRows:=True, _
        AllowInsertingHyperlinks:=True, _
        AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, _
        AllowSorting:=True, _
        AllowFiltering:=True, _
        AllowUsingPivotTables:=True, _
        UserInterfaceOnly:=True
 End With
End Sub

Bonjour i20100

Dans un autre programme j'ai remplacé ce qui est en commentaire (vert)

Est-ce possible de faire la même chose?

Merci à toi

Cordialement

Option Explicit
Sub Init_Feuille()
Dim J As Long, I As Integer
Dim WSheet As Worksheet
Dim Feuilles, Medicaments

  Feuilles = Array("aa")
  Medicaments = Array("bb")
  For I = 0 To 0
    Set WSheet = Sheets(Feuilles(I))
    Protection WSheet                         '  WSheet.Protect UserInterfaceOnly:=True

    For J = 3 To 102
      If WSheet.Range("D" & J) <> "" Then
        If (WSheet.Range("C" & J) = Medicaments(I)) Or (WSheet.Range("A" & J) = Date) Then
          WSheet.Range("D" & J).Font.ColorIndex = 5
        ElseIf Weekday(WSheet.Range("A" & J), vbMonday) > 5 Or Application.CountIf(WSheet.Range("JoursFériés"), WSheet.Range("A" & J)) > 0 Then
          WSheet.Range("D" & J).Font.ColorIndex = 38
        ElseIf WSheet.Range("A" & J) <> Date Then
          WSheet.Range("D" & J).Font.ColorIndex = 15
        Else
          WSheet.Range("D" & J).Font.ColorIndex = 5
        End If
      End If
    Next J

  Next I
   Protection Sheets("aa")      ' Sheets("aa").Protect UserInterfaceOnly:=True

End Sub

re,

il faudrait voir la macro Protection ...

Re

Je n'ai pas de macro protection

j'ai ça dans ThisWorkbook

Private Sub Workbook_Open()
Dim Sh As Worksheet
  For Each Sh In Sheets
  Sh.Protect UserInterfaceOnly:=True
  Next Sh
End Sub

re,

regarde plus, car cette ligne

Protection WSheet 

appel une macro nommée Protection

Re

Dans Tri j'ai ça aussi

' Début modification le 15/02/2020 - Centralisation de la protection des feuilles

Sub Protection(Feuille As Worksheet)
  Feuille.Protect UserInterfaceOnly:=True
End Sub

' Fin modification le 15/02/2020 - Centralisation de la protection des feuilles

c'est sur cette macro Protection

qu'il faut faire la modification désiré.

Re

Oh! Punaise pour ne pas employer un autre mot!! Quel C$N!!!

Merci à toi

Cordialement

contente que tu aies trouvé @+

Re i20100

Il y a un moment on ne voit plus rien!!!

Il faut que ça soit un œil "neutre" qui regarde sinon...des heures passées pour une "inattention" de RIRN

Merci encore à toi et bonne journée

Très cordialement