Bonjour, voici le code me posant problème :
Private Sub BoutonSup_Click()
Dim i, iligne, colonne, colonnecadre As Byte
'E-mail cellule=cellule sélectionné
Dim trouve As Boolean
trouve = False
'NBX de fois que l'E-mai la été trouvé
Dim nbxtrouve As Byte
nbxtrouve = 0
'Vérifie qu'un E-mai la été sélectionné
If ComboSup.Value = "" Then
MsgBox "Sélectionnez d'abord un E-mail."
Exit Sub
End If
'Recherche de l'E-MaiL
For i = 1 To 8
Select Case i
'RETAD
Case 1
colonne = ColonneRETADesti
colonnecadre = ColonneRETADesti
'RETAC
Case 2
colonne = ColonneRETACopie
colonnecadre = ColonneRETADesti
'INFOGARED
Case 3
colonne = ColonneINFOGAREDesti
colonnecadre = ColonneINFOGAREDesti
'INFOGAREC
Case 4
colonne = ColonneINFOGARECopie
colonnecadre = ColonneINFOGAREDesti
'VIDEOD
Case 5
colonne = ColonneVIDEODesti
colonnecadre = ColonneVIDEODesti
'VIDEOC
Case 6
colonne = ColonneVIDEOCopie
colonnecadre = ColonneVIDEODesti
'CNSETD
Case 7
colonne = ColonneCNSETDesti
colonnecadre = ColonneCNSETDesti
'CNSETC
Case 8
colonne = ColonneCNSETCopie
colonnecadre = ColonneCNSETDesti
End Select
'Parcours des colonnes
iligne = ligneEmail
'iligne>100 pour éviter une éventuelle boucle infinie
Do While (Worksheets("Emails").Cells(iligne, colonne) <> "") Or iligne > 100
'Teste si l'on se trouve sur la cellule de l'E-mail à supprimer
If Worksheets("Emails").Cells(iligne, colonne) = ComboSup.Value Then
ActiveWorkbook.Worksheets("Emails").Cells(iligne, colonne).Delete (xlUp)
'Pour garder les cadres E-MaiLs égaux
'Worksheets("Emails").Cells(38, colonne).Insert Shift:=xlDown
trouve = True
nbxtrouve = nbxtrouve + 1
Exit Do
End If
iligne = iligne + 1
Loop
Next i
'Message indiquant le résultat de la suppression
If trouve = True Then
MsgBox ComboSup.Value & " effacé " + CStr(nbxtrouve) + " fois."
ComboSup.RemoveItem (ComboSup.ListIndex)
ComboSup.ListIndex = 0
Else
MsgBox "Erreur, l'E-mail n'a pas été trouvé."
End If
End Sub
D'avance merci
Bonne fin de journée à tous