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

wishtolearn

XLDnaute Nouveau
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)

VB:
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")

Code:
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.
 
Solution
Bonsoir le fil

Une version tout en un (pour protection/déprotection)
VB:
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

GALOUGALOU

XLDnaute Accro
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
Enrichi (BBcode):
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
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Une version tout en un (pour protection/déprotection)
VB:
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

XLDnaute Nouveau
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.

VB:
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

XLDnaute Barbatruc
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)
VB:
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
 

Discussions similaires

Réponses
14
Affichages
621

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 868
dernier inscrit
pierreselo33