Suppression de la meme ligne dans plusieurs feuilles en meme temps

Dim identifiant      As String

Dim ligne_active     As Range

Dim lignes_a_suppr() As Range

Dim cell             As Range

Dim msg              As String

Dim i                As Integer

 
ReDim lignes_a_suppr(1 To Worksheets.Count)

 
Set ligne_active = ActiveCell.EntireRow

Set lignes_a_suppr(ligne_active.Worksheet.Index) = ligne_active

identifiant = ligne_active.Columns("D").Text

If identifiant = "" Then

    MsgBox "Cette ligne ne contient pas d'identifiant !"

    Exit Sub

End If

 
For Each ws In Worksheets

    If Not ws Is ligne_active.Worksheet Then

        For Each cell In ws.Range("D2", ws.Cells(ws.Rows.Count, 4).End(xlUp))

            If cell.Text = identifiant Then

                Set lignes_a_suppr(ws.Index) = cell.EntireRow

                Exit For

            End If

        Next

    End If

Next

 
msg = "Les lignes à supprimer sont "

For i = 1 To Worksheets.Count

    If Not lignes_a_suppr(i) Is Nothing Then

        msg = msg & vbCrLf & " * Feuille " & i & ", ligne " & lignes_a_suppr(i).Row

    End If

Next

msg = msg & vbCrLf & vbCrLf & "Supprimer ces lignes ?"

 
If vbOK <> MsgBox(msg, vbOKCancel Or vbExclamation) Then Exit Sub

 
For i = 1 To Worksheets.Count

    lignes_a_suppr(i).Delete

Next

For i = 1 To Worksheets.Count

    If Not lignes_a_suppr(i) Is Nothing Then

        lignes_a_suppr(i).Delete

    End If

Next