XL 2016 MSGBOX en double

[Aldonanou]

Bonjour,

Dans le cas de suivi de production, il est nécessaire, lors de la suppression d'un enregistrement sur l'onglet ArchivesA d'en avoir une copie sur l'onglet Suppression Accueil. Et ensuite de supprimer la ligne sélectionnée initialement de l'onglet ArchivesA pour que les enregistrements suivants se positionnent à la suite (action via un Userform).

J'ai bien le message "Cette référence n'existe pas !" lorsque la valeur n'est pas trouvée. Par contre, bien que l'information remonte avec "Enregistrement supprimé" pour une valeur trouvée + supprimée, la procédure m'affiche aussi "Cette référence n'existe pas !. Il y a certainement quelque chose qui manque.

Je n'arrive pas à trouver de solutions malgré toutes les recherches effectuées.

Quelqu'un pourrait-il me venir en aide. Merci

Bien cordialement

Ci-après le code utilisé

Private Sub SuppEnregA_Click()

Dim xRange As Range
Dim I As Long 'valeur dernière ligne active onglet ArchivesA
Dim J As Long 'valeur dernière ligne active onglet Suppression Accueil
Dim K As Long
Dim G As Long
Dim Ref As Long

I = Worksheets("ArchivesA").UsedRange.Rows.Count 'Nombre de ligne utilisées onglet ArchivesA
J = Worksheets("Suppression Accueil").UsedRange.Rows.Count 'nombre de ligne utilisées onglet Suppression Accueil
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Suppression Accueil").UsedRange) = 0 Then J = 0
End If
Set xRange = Worksheets("ArchivesA").Range("B2:B" & I)
On Error Resume Next
Application.ScreenUpdating = False

Ref = InputBox("Référence de l'enregistrement à supprimer ?")
For K = 1 To xRange.Count

If xRange(K) = Ref Then
xRange(K).EntireRow.Copy Destination:=Worksheets("Suppression Accueil").Range("A" & J + 1)
xRange(K).EntireRow.Delete

' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intpout = MsgBox("Enregistrement supprimé", vbInformation, "")
End If
Next


' Cette partie fonctionne sans le message
If xRange(G) <> Ref Then 'Exit Sub
MsgBox "Cette référence n'existe pas !"""
Exit Sub
End If

Application.ScreenUpdating = True

End Sub

 

[M12]

Bonjour,

Dans le cas de suivi de production, il est nécessaire, lors de la suppression d'un enregistrement sur l'onglet ArchivesA d'en avoir une copie sur l'onglet Suppression Accueil. Et ensuite de supprimer la ligne sélectionnée initialement de l'onglet ArchivesA pour que les enregistrements suivants se positionnent à la suite (action via un Userform).

J'ai bien le message "Cette référence n'existe pas !" lorsque la valeur n'est pas trouvée. Par contre, bien que l'information remonte avec "Enregistrement supprimé" pour une valeur trouvée + supprimée, la procédure m'affiche aussi "Cette référence n'existe pas !. Il y a certainement quelque chose qui manque.

Je n'arrive pas à trouver de solutions malgré toutes les recherches effectuées.

Quelqu'un pourrait-il me venir en aide. Merci

Bien cordialement

Ci-après le code utilisé

Private Sub SuppEnregA_Click()

Dim xRange As Range
Dim I As Long 'valeur dernière ligne active onglet ArchivesA
Dim J As Long 'valeur dernière ligne active onglet Suppression Accueil
Dim K As Long
Dim G As Long
Dim Ref As Long

I = Worksheets("ArchivesA").UsedRange.Rows.Count 'Nombre de ligne utilisées onglet ArchivesA
J = Worksheets("Suppression Accueil").UsedRange.Rows.Count 'nombre de ligne utilisées onglet Suppression Accueil
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Suppression Accueil").UsedRange) = 0 Then J = 0
End If
Set xRange = Worksheets("ArchivesA").Range("B2:B" & I)
On Error Resume Next
Application.ScreenUpdating = False

Ref = InputBox("Référence de l'enregistrement à supprimer ?")
For K = 1 To xRange.Count

If xRange(K) = Ref Then
xRange(K).EntireRow.Copy Destination:=Worksheets("Suppression Accueil").Range("A" & J + 1)
xRange(K).EntireRow.Delete

' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intpout = MsgBox("Enregistrement supprimé", vbInformation, "")
End If
Next


' Cette partie fonctionne sans le message
If xRange(G) <> Ref Then 'Exit Sub
MsgBox "Cette référence n'existe pas !"""
Exit Sub
End If

Application.ScreenUpdating = True

End Sub

Bonjour,
Rajoute un Exit Sub après ton Intput

' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intput = MsgBox("Enregistrement supprimé", vbInformation, "")
Exit Sub
End If

Next

 

[Aldonanou]

Bonjour,
Rajoute un Exit Sub après ton Intput

' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intput = MsgBox("Enregistrement supprimé", vbInformation, "")
Exit Sub
End If

Next

Bonjour M12,

Merci pour le retour. C'est impeccable, cela fonctionne à merveille.

Cordialement