XL 2016 [VBA] Rajout d'une condition sur deux macros excel

[wishtolearn]

Bonjour à tous les experts Excel,

J'ai trouvé deux macros que je souhaite peaufiner et comme je n'y connais rien en VBA j'aurai donc besoin de vos lumières

1ère macro: j'aimerai que le cut de la macro se fasse uniquement en fonction de la colonne G ET de la colonne I (pour le moment il n'y a qu'une condition et je n'arrive pas à rajouter la seconde, la colonne I)

Sub Others()
    Dim i As Variant
    Dim endrow As Integer
    Dim DAV As Worksheet, OTH As Worksheet

    Set DAV = ActiveWorkbook.Sheets("Demandes à valider")
    Set OTH = ActiveWorkbook.Sheets("Other")

    endrow = DAV.Range("A" & DAV.Rows.Count).End(xlUp).Row

    For i = 2 To endrow
        If DAV.Cells(i, "G").Value = "Others" Then
           DAV.Cells(i, "G").EntireRow.Cut Destination:=OTH.Range("A" & OTH.Rows.Count).End(xlUp).Offset(1)
        End If
    Next
End Sub

2nde macro: j'aimerai exclure une feuille de cette macro de protection globale à savoir protège toutes les feuilles SAUF la feuille "Demandes à valider")

Sub UnProtectAll()
 
    On Error GoTo ErrorOccured
  
    Dim pwd1 As String
    pwd1 = InputBox("Please Enter the password")
    If pwd1 = "motdepasse" Then Exit Sub
    For Each ws In Worksheets
        ws.Unprotect Password:=pwd1
    Next
    MsgBox "All sheets UnProtected."

    Exit Sub
    
ErrorOccured:
    MsgBox "Sheets could not be UnProtected - Password Incorrect"
    Exit Sub
    
End Sub

Merci d'avance pour votre aide.

 

[GALOUGALOU]

bonjour le forum bonjour wishtolearn
commençons par la deuxième question
la macro proposé ne protège pas les feuilles mais au contraire enlève la protection
pour protéger et exclure une feuille voir le code

Sub ProtectAll()
  
    Dim pwd1 As String
    pwd1 = InputBox("Please Enter the password")
    If pwd1 = "motdepasse" Then Exit Sub
    For Each WS In Worksheets
        If WS.Name <> "Demandes à valider" Then
        WS.Protect Password:=pwd1
        End If
    Next
    MsgBox "All sheets Protected."

    Exit Sub
    
    
End Sub

pour la 1er question

if condition1 and condition2 then
cordialement
galougalou

 

[wishtolearn]

Merci pour ton aide précieuse. Pour la 1ère question ça marche impec

Par contre pour la seconde j'ai un message d'erreur, quand je clique sur Débug ça m'affiche en jaune la ligne

If WS.Name <> "Demandes à valider" Then

Saurais-tu pourquoi?

 

[GALOUGALOU]

Bonsoir le fil
Certainement un problème de nom avec la feuille
essaie de poster un classeur pour qu'on puisse juger sur pièce.
sur mon ordi la macro avait fonctionné sans problème
Cordialement
Galougalou

 

[GALOUGALOU]

bonsoir le fil
en complément du post #4
un classeur avec le code du post #2
@+

 

[wishtolearn]

Je vais tester à nouveau demain et je te tiens au courant.

Merci pour ta réponse.

 

[Staple1600]

Bonsoir le fil

Une version tout en un (pour protection/déprotection)

Sub Protege()
Protection True
End Sub
Sub Deprotege()
Protection False
End Sub
Sub Protection(verrou As Boolean)
Dim pwd1$
pwd1 = InputBox("Please Enter the password")
For Each ws In Worksheets
If Not ws.Name = "Feuil1" Then '-< ici mettre le nom de la feuille à ne pas protéger
Select Case verrou
Case True
ws.Protect Password:=pwd1
Case False
ws.Unprotect Password:=pwd1
End Select
End If
Next
End Sub

 

[wishtolearn]

Ça fonctionne. J'ai pris le dernier code du coup qui est encore plus pratique. Merci à vous deux.

 

[wishtolearn]

Re,


Est-il possible de rajouter des feuille à cette macro? En fait j'ai cette même macro pour chaque feuille (1pour others, 1 pour demande facile, 1 pour demande difiiciles, etc..), le seul truc qui change c'est le titre de la feuille, puisque les conditions sont toujours les mêmes.

Ma question est donc: est-il possible d'avoir cette macro en global, plutôt que d'avoir à cliquer sur 10 boutons? Merci beaucoup par avance.

Sub Others()
    Dim i As Variant
    Dim endrow As Integer
    Dim DAV As Worksheet, OTH As Worksheet

    Set DAV = ActiveWorkbook.Sheets("Demandes à valider")
    Set OTH = ActiveWorkbook.Sheets("Other & Special Requests")

    endrow = DAV.Range("A" & DAV.Rows.Count).End(xlUp).Row

    For i = 2 To endrow
        If DAV.Cells(i, "G").Value = "Others" And DAV.Cells(i, "I").Value = "To be Done" Then
           DAV.Cells(i, "G").EntireRow.Cut Destination:=OTH.Range("A" & OTH.Rows.Count).End(xlUp).Offset(1)
        End If
    Next
End Sub

 

[Staple1600]

Bonjour le fil, wishtolearn

Normalement nouvelle question=nouvelle discussion
(Cette dernière question n'ayant rien à voir avec celle posée dans le premier message de cette discussion)
Puisqu'elle est posée, je réponds néanmoins ici
(sous réserve d'avoir bien compris ce qu'il faut faire)

Sub Others_bis()
Dim i&, endrow&, ws As Worksheet, OTH As Worksheet
Set OTH = ActiveWorkbook.Sheets("Other & Special Requests")
For Each ws In Worksheets
If ws.Name <> "Other & Special Requests" Then
endrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    For i = 2 To endrow
        If ws.Cells(i, "G").Value = "Others" And ws.Cells(i, "I").Value = "To be Done" Then
           ws.Cells(i, "G").EntireRow.Cut Destination:=OTH.Range("A" & OTH.Rows.Count).End(xlUp).Offset(1)
        End If
    Next
End Sub