Probleme dans ma macro

bonjour

j'ai un probleme avec ma macro,

je rentre d'abord un mot de passe ensuite j'ai une fenetre qui apparait qui demande l'accord soit OK ou NOK

si Ok je copie la cellule F46 dans le classeur liste en colonne T en fonction de la ligne

si NOk il y aune fenetre qui apparait pour motif

le motif doive être copie dans le classeur liste colonne W

Je n'arrive pas a comprendre mon erreur

voici la macro

Sub QUALITE()

Dim Mdp As String, accord As String, motif As String

Mdp = Application.InputBox("Veuillez introduire votre mot de passe")

If Mdp <> "1" Then MsgBox "Accès refusé !": Exit Sub

accord = Application.InputBox("OK ou NOK")

If accord <> "OK" Then motif = Application.InputBox("motif") ': Exit Sub

N° = Range("H8").Value

Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)

If Not Cel Is Nothing Then

Sheets("liste").Range("W" & Cel.Row).Value = motif

'Exit Sub

End If

'Sheets("liste").Range("W" & Cel.Row).Value = motif

'Exit Sub

If Range("F46").Value = "" Then

MsgBox " Saisissez une date Qualité !", 16

End

End If

N° = Range("H8").Value

Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)

If Not Cel Is Nothing Then

Sheets("liste").Range("S" & Cel.Row).Value = "Qualite"

Sheets("liste").Range("T" & Cel.Row).Value = Range("I8").Value

End If

Sheets("etat imprimante").Select

ActiveWorkbook.Save

Exit Sub

End Sub

Je cois que mon probleme vient des exit sub et des end if

Pouvez vous m'aider

Bonjour,

une proposition d'adaptation

Sub QUALITE()

    Dim Mdp As String, accord As String, motif As String

    Mdp = Application.InputBox("Veuillez introduire votre mot de passe")
    If Mdp <> "1" Then MsgBox "Accès refusé !": Exit Sub 'accès refusé on arrête

    accord = Application.InputBox("OK ou NOK")
    If accord <> "OK" Then ' ce n'est pas ok , on demande un motif , et on le sauve en colonne W, pour le Numero trouvé en H8

        motif = Application.InputBox("motif")

        N° = Range("H8").Value
        Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)
        If Not Cel Is Nothing Then Sheets("liste").Range("W" & Cel.Row).Value = motif

    ElseIf Range("F46").Value = "" Then ' si la cellule F46 est vide on arrête
        MsgBox " Saisissez une date Qualité en F46!", 16: Exit Sub

    Else 'sinon on copie l'info I8 en colonne T pour le numéro trouvé en H8

        N° = Range("H8").Value
        Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)
        If Not Cel Is Nothing Then
            Sheets("liste").Range("S" & Cel.Row).Value = "Qualite"
            Sheets("liste").Range("T" & Cel.Row).Value = Range("I8").Value
        End If
    End If ' ici cela dépend de ce que tu veux faire, pas possible de se faire une idée sur base de ton code.
    Sheets("etat imprimante").Select
    ActiveWorkbook.Save

End Sub

Bonjour

Merci

j'aurai encore besoin de vous

voici la macro Option Explicit

Dim T, C, D, DerLn

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("A3:A" & Application.Max(3, Range("A" & Rows.Count).End(xlUp).Row))) Is Nothing Then

Sheets("etat imprimante").Range("H8").Value = Target.Value

Sheets("etat imprimante").Range("D41") = Sheets("etat imprimante").Range("I7").Value

Sheets("etat imprimante").Range("F46") = Sheets("etat imprimante").Range("I9").Value

Sheets("etat imprimante").Select

'copie P1 dans D41

'.Range("P1").Select

'Selection.Copy

'Range("D41").Select

'ActiveSheet.Paste

'Range("P7").Select

'Application.CutCopyMode = False

End If

End Sub

Private Sub OptionRefusé_Click()

T = "REFUSE"

Call MiseAjour

End Sub

Private Sub Optionencours_Click()

T = "EN COURS"

Call MiseAjour

End Sub

Private Sub Optionterminer_Click()

T = "TERMINER"

Call MiseAjour

End Sub

Private Sub OptionQUALITE_Click()

T = "NOK"

Call MiseAjour

End Sub

Sub MiseAjour()

If T = "NOK" Then ' je voudrais afficher que les en cours avec les nok

Application.ScreenUpdating = False

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

Range("A3:W" & DerLn + 1).ClearContents

Application.DisplayAlerts = False

With Sheets("liste")

For Each C In .Range("S3:S" & Application.Max(3, .Range("S" & Rows.Count).End(xlUp).Row))

If UCase(C.Value) = T Then

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

.Range("A" & C.Row & ":W" & C.Row).Copy

Range("A" & DerLn + 1).PasteSpecial xlPasteAll

End If

Next C

End With

Application.CutCopyMode = False

Range("A2").Select

End If

If T <> "NOK" Then ' affiche soit les en cours ou les terminer ou les refuse

Application.ScreenUpdating = False

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

Range("A3:W" & DerLn + 1).ClearContents

Application.DisplayAlerts = False

With Sheets("liste")

For Each C In .Range("P3:P" & Application.Max(3, .Range("P" & Rows.Count).End(xlUp).Row))

If UCase(C.Value) = T Then

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

.Range("A" & C.Row & ":W" & C.Row).Copy

Range("A" & DerLn + 1).PasteSpecial xlPasteAll

End If

Next C

End With

Application.CutCopyMode = False

Range("A2").Select

End If

End Sub

le probleme c'est que je souhaite trier en un clic soit

terminer cela fonctionne

En cours cela fonctionne

refusé cela fonctionne

NOk ne fonctionne pas ( je voudrais qu'il m'affiche les en cours + les nok et actuelement il m'affiche les NOk + en cours + refusé)

Bonjour,

désolé le code n'est pas en soi suffisant pour comprendre ce qu'il faut corriger. Comment puis-je déterminer une action en cours ? sur base de quelle valeur dans quelle colonne ?

Rechercher des sujets similaires à "probleme macro"