Supprimer doublon et cellules vides dans worksheet_Change

Bonjour

Besoin d'aide pour que le résultat retourné dans la colonne A soit sans doublons et que celui dans la colonne B ne retourne pas les cellules vide

Merci

Private Sub Worksheet_Change(ByVal Target As Range)

Dim iLigFin As Integer

Dim iLig As Integer

Dim iEcr As Integer

Dim iLigFin2 As Integer

Dim iLig2 As Integer

Dim iEcr2 As Integer

If Target.Count = 1 Then

If Target.AddressLocal = "$B$1" Then

iLigFin = Range("a" & Rows.Count).End(xlUp).Row

iLigFin2 = Range("b" & Rows.Count).End(xlUp).Row

If iLigFin >= 7 Then

Range("a8:a" & iLigFin).ClearContents

End If

If iLigFin2 >= 30 Then

Range("b29:b" & iLigFin2).ClearContents

End If

iEcr = 7

iLigFin = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row

iEcr2 = 29

iLigFin2 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row

For iLig = 2 To iLigFin

If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then

Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value

iEcr = iEcr + 1

End If

Next iLig

For iLig2 = 2 To iLigFin2

If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then

Range("B" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value

iEcr2 = iEcr2 + 1

End If

Next iLig2

End If

End If

End Sub

Bonjour,

il faut mettre au début de la macro,

Application.EnableEvents = False

et à la fin de la macro,

Application.EnableEvents = True

Merci i20100

L'ajout du code proposé ne fonctionne pas

Par contre j'ai trouvé pour les doublons

For iLig = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then
                    Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value
                    Sheets("Facture").Range("a1:a75").RemoveDuplicates Columns:=1, Header:=xlNo
                    iEcr = iEcr + 1
                End If
            Next iLig

Et pour les cellules vides

or iLig2 = 2 To iLigFin2
                If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then
                    Range("b" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value
                    Range("c" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("ak" & iLig2).Value
                    Range("d" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("aq" & iLig2).Value
                    iEcr2 = iEcr2 + 1

                    Sheets("Facture").Range("b25:d100").SpecialCells(xlCellTypeBlanks).Delete xlUp
                        Range("B25:d100").Select
                            With Selection.Font
                            .Name = "Calibri"
                            .Size = 10
                            .ThemeColor = xlThemeColorLight1
                            .ThemeFont = xlThemeFontMinor
                            End With
                            Selection.Font.Italic = True
                       Range("D24").Select
                        ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[76]C)"
                        Range("D25").Select
                        ActiveWindow.SmallScroll Down:=-6
                End If
            Next iLig2

Est-ce que le code pourrait au complet pourrait être simplifié et gagner en rapidité?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim iEcr As Integer
    Dim iLigFin2 As Integer
    Dim iLig2 As Integer
    Dim iEcr2 As Integer

    If Target.Count = 1 Then
        If Target.AddressLocal = "$B$1" Then
            iLigFin = Range("a" & Rows.Count).End(xlUp).Row
            iLigFin2 = Range("b" & Rows.Count).End(xlUp).Row

            If iLigFin >= 7 Then
                Range("a8:a" & iLigFin).ClearContents
            End If

            If iLigFin2 >= 25 Then
                Range("b26:d100" & iLigFin2).ClearContents
            End If

            iEcr = 7
            iLigFin = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row

            iEcr2 = 25
            iLigFin2 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row

            For iLig = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then
                    Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value
                    Sheets("Facture").Range("a1:a75").RemoveDuplicates Columns:=1, Header:=xlNo
                    iEcr = iEcr + 1
                End If
            Next iLig

            For iLig2 = 2 To iLigFin2
                If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then
                    Range("b" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value
                    Range("c" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("ak" & iLig2).Value
                    Range("d" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("aq" & iLig2).Value
                    iEcr2 = iEcr2 + 1

                    Sheets("Facture").Range("b25:d100").SpecialCells(xlCellTypeBlanks).Delete xlUp
                        Range("B25:d100").Select
                            With Selection.Font
                            .Name = "Calibri"
                            .Size = 10
                            .ThemeColor = xlThemeColorLight1
                            .ThemeFont = xlThemeFontMinor
                            End With
                            Selection.Font.Italic = True
                       Range("D24").Select
                        ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[76]C)"
                        Range("D25").Select
                        ActiveWindow.SmallScroll Down:=-6
                End If
            Next iLig2

        End If
  End If
Application.ScreenUpdating = 0
Application.EnableEvents = True
End Sub

Merci