Fusion de 2 worksheet_Change

Version imprimable

Bonjour

Besoin d'aide pour fusionner 2 codes

Le code suivant fonctionne très bien, il valide la valeur de la cellule B1 dans la colonne A d'une autre feuille et retourne toute les valeur inscrite en G

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim iEcr As Integer
 
 
    If Target.Count = 1 Then
        If Target.AddressLocal = "$B$1" Then
            iLigFin = Range("a" & Rows.Count).End(xlUp).Row
            If iLigFin >= 7 Then
                Range("a8:a" & iLigFin).ClearContents
            End If
 
            iEcr = 7
            iLigFin = 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
       End if
 End if
End sub

1 ière question, comment supprimer les doublons de ce résultat

Autre point, je voudrais ajouter au code qu'il retourne également les valeurs inscrites en AL

Comment ajouter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
If Target.AddressLocal = "$b$1" Then
            iLigFin = Range("b" & Rows.Count).End(xlUp).Row
            If iLigFin >= 29 Then
                Range("b29:b" & iLigFin).ClearContents
            End If
 
            iEcr = 29
            iLigFin = Sheets("Facturation_Détaillée").Range("al" & Rows.Count).End(xlUp).Row
            For iLig = 2 To iLigFin
                If Sheets("Facturation_Détaillée").Range("al" & iLig).Value = Target.Value Then
                    Range("al" & iEcr).Value = Sheets("Facturation_Détaillée").Range("al" & iLig).Value
                    iEcr = iEcr + 1

Merci

Bonjour

J'ai réussi a fusionner les codes

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
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

Par contre comment supprimer les doublons du résultat de la colonne A et les cellules "vide" de AL

Merci

Pour les intéressés

J'ai réussis à supprimer les doublons du résultat retourné dans la colonne A

Code:

1
2
3
4
5
6
7
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

Mais cherche toujours à ce que les cellules vides (AL = "")ne soient pas retournées dans le résultat voulu à la colonne B

Code:

1
2
3
4
5
6
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

Merci de m'aider

Pour les intéressés

J'ai trouvé + également ajouté une mise en forme

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 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
                    Sheets("Facture").Range("b29:b100").SpecialCells(xlCellTypeBlanks).Delete xlUp
                        Range("B29:b100").Select
                            With Selection.Font
                            .Name = "Calibri"
                            .Size = 10
                            End With
                            With Selection
                                .HorizontalAlignment = xlRight
                                .VerticalAlignment = xlBottom
                            End With
                End If
            Next iLig2