[VBA Excel] - Copier ligne si un ID pas présent dans annuaire

**edgarrd** · 02/04/2024, 11h56

Bonjour à tous

J'espère que le long week-end de Pâques fut bon.

Je vous sollicite pour une petit souci en VBA dont je ne trouve pas la solution.

Je dispose de deux classeurs: ClasseursA et ClasseursB. Le ClasseurA dispose en colonne D d'dientifiant client qui changent de manière mensue; c'est un fichier accesible par le management seulement. ClasseurB reprends exactement les mêmes data mais est nominatif et accessible par un individu propre.

Je souhaiterais rafraichir ClasseurB en fonction de ClasseurA.

J'ai tenté ce code qui marche partiellemt mais sur une même feuille donc ce n'est pas top:

Sub Refreh()
nbLigA = Range("D" & Rows.Count).End(xlUp).Row
NbLigB = Range("D" & Rows.Count).End(xlUp).Row
If NbLigB > 1 Then NbLigB = NbLigB + 1
For i = 1 To nbLigA
If IsError(Application.Match(Cells(i, 4), Range("D

"), 0)) Then
Cells(NbLigB, 4) = Cells(i, 4)
NbLigB = NbLigB + 1
End If
Next i
End Sub

Pourriez-vous m'aider svp ?

Merci

**Franc** · 02/04/2024, 14h11

Bonjour, ne sachant pas si les classeurs sont ouverts ou pas, j'ai ajouté une fonction pour vérifier. N'oubliez pas de changer les noms des feuilles et chemins d'accès aux classeurs.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function WorkbookIsOpen(ByVal WorkbookName As String) As Boolean
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(WorkbookName)
    On Error GoTo 0
    If Not wb Is Nothing Then WorkbookIsOpen = True
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
Sub Refresh()
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Dim nbLigA As Long, nbLigB As Long, i As Long
    Dim ClasseurA As String, ClasseurB As String
 
    ClasseurA = "ClasseurA.xlsx"
    ClasseurB = "ClasseurB.xlsx"
 
    ' Vérifier si les classeurs sont déjà ouverts
    If Not WorkbookIsOpen(ClasseurA) Then
        Set wbA = Workbooks.Open("C:\chemin\vers\ClasseurA.xlsx")
    Else
        Set wbA = Workbooks(ClasseurA)
    End If
 
    If Not WorkbookIsOpen(ClasseurB) Then
        Set wbB = Workbooks.Open("C:\chemin\vers\ClasseurB.xlsx")
    Else
        Set wbB = Workbooks(ClasseurB)
    End If
 
    ' Sélectionner les feuilles de calcul
    Set wsA = wbA.Sheets("Feuil1")
    Set wsB = wbB.Sheets("Feuil1")
 
    ' Trouver le nombre de lignes dans chaque feuille de calcul
    nbLigA = wsA.Range("D" & wsA.Rows.Count).End(xlUp).Row
    nbLigB = wsB.Range("D" & wsB.Rows.Count).End(xlUp).Row
 
    ' Si ClasseurB a des données, passer à la ligne suivante
    If nbLigB > 1 Then nbLigB = nbLigB + 1
 
    ' Parcourir les lignes dans ClasseurA
    For i = 1 To nbLigA
        ' Vérifier si l'identifiant client existe dans ClasseurB
        If IsError(Application.Match(wsA.Cells(i, 4), wsB.Range("D:D"), 0)) Then
            ' Ajouter l'identifiant client à ClasseurB s'il n'existe pas
            wsB.Cells(nbLigB, 4) = wsA.Cells(i, 4)
            nbLigB = nbLigB + 1
        End If
    Next i
 
    ' Enregistrer et fermer les classeurs
    If Not WorkbookIsOpen(ClasseurA) Then
        wbA.Close SaveChanges:=False
    End If
    If Not WorkbookIsOpen(ClasseurB) Then
        wbB.Close SaveChanges:=True
    End If
End Sub

**edgarrd** · 02/04/2024, 14h21

Envoyé par Franc

Bonjour, ne sachant pas si les classeurs sont ouverts ou pas, j'ai ajouté une fonction pour vérifier. N'oubliez pas de changer les noms des feuilles et chemins d'accès aux classeurs.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function WorkbookIsOpen(ByVal WorkbookName As String) As Boolean
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(WorkbookName)
    On Error GoTo 0
    If Not wb Is Nothing Then WorkbookIsOpen = True
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
Sub Refresh()
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Dim nbLigA As Long, nbLigB As Long, i As Long
    Dim ClasseurA As String, ClasseurB As String
 
    ClasseurA = "ClasseurA.xlsx"
    ClasseurB = "ClasseurB.xlsx"
 
    ' Vérifier si les classeurs sont déjà ouverts
    If Not WorkbookIsOpen(ClasseurA) Then
        Set wbA = Workbooks.Open("C:\chemin\vers\ClasseurA.xlsx")
    Else
        Set wbA = Workbooks(ClasseurA)
    End If
 
    If Not WorkbookIsOpen(ClasseurB) Then
        Set wbB = Workbooks.Open("C:\chemin\vers\ClasseurB.xlsx")
    Else
        Set wbB = Workbooks(ClasseurB)
    End If
 
    ' Sélectionner les feuilles de calcul
    Set wsA = wbA.Sheets("Feuil1")
    Set wsB = wbB.Sheets("Feuil1")
 
    ' Trouver le nombre de lignes dans chaque feuille de calcul
    nbLigA = wsA.Range("D" & wsA.Rows.Count).End(xlUp).Row
    nbLigB = wsB.Range("D" & wsB.Rows.Count).End(xlUp).Row
 
    ' Si ClasseurB a des données, passer à la ligne suivante
    If nbLigB > 1 Then nbLigB = nbLigB + 1
 
    ' Parcourir les lignes dans ClasseurA
    For i = 1 To nbLigA
        ' Vérifier si l'identifiant client existe dans ClasseurB
        If IsError(Application.Match(wsA.Cells(i, 4), wsB.Range("D:D"), 0)) Then
            ' Ajouter l'identifiant client à ClasseurB s'il n'existe pas
            wsB.Cells(nbLigB, 4) = wsA.Cells(i, 4)
            nbLigB = nbLigB + 1
        End If
    Next i
 
    ' Enregistrer et fermer les classeurs
    If Not WorkbookIsOpen(ClasseurA) Then
        wbA.Close SaveChanges:=False
    End If
    If Not WorkbookIsOpen(ClasseurB) Then
        wbB.Close SaveChanges:=True
    End If
End Sub

Merci beaucoup pour votre sollicitude et votre retour ultra rapide.
Le code fonctionne a une exception près (que je n'ai pas mentionné...Désolé). Il faudrait copier toute la ligne en question et aussi supprimer la ligne si elle n'est pas dans la source.

Merci encore Franc

**Franc** · 02/04/2024, 14h40

Modifications faites.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub Refresh()
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Dim nbLigA As Long, nbLigB As Long, i As Long, j As Long
    Dim ClasseurA As String, ClasseurB As String
    Dim copyRange As Range
 
    ClasseurA = "ClasseurA.xlsx"
    ClasseurB = "ClasseurB.xlsx"
 
    ' Vérifier si les classeurs sont déjà ouverts
    If Not WorkbookIsOpen(ClasseurA) Then
        Set wbA = Workbooks.Open("C:\chemin\vers\ClasseurA.xlsx")
    Else
        Set wbA = Workbooks(ClasseurA)
    End If
 
    If Not WorkbookIsOpen(ClasseurB) Then
        Set wbB = Workbooks.Open("C:\chemin\vers\ClasseurB.xlsx")
    Else
        Set wbB = Workbooks(ClasseurB)
    End If
 
    Set wsA = wbA.Sheets("Feuil1")
    Set wsB = wbB.Sheets("Feuil1")
 
    ' Trouver le nombre de lignes dans chaque feuille de calcul
    nbLigA = wsA.Range("D" & wsA.Rows.Count).End(xlUp).Row
    nbLigB = wsB.Range("D" & wsB.Rows.Count).End(xlUp).Row
 
    ' Si ClasseurB a des données, passer à la ligne suivante
    If nbLigB > 1 Then nbLigB = nbLigB + 1
 
    ' Parcourir les lignes dans ClasseurA
    For i = 1 To nbLigA
        ' Vérifier si l'identifiant client existe dans ClasseurB
        If IsError(Application.Match(wsA.Cells(i, 4), wsB.Range("D:D"), 0)) Then
            ' Copier toute la ligne à ClasseurB si l'identifiant client n'existe pas
            Set copyRange = wsA.Rows(i)
            copyRange.Copy Destination:=wsB.Rows(nbLigB)
            nbLigB = nbLigB + 1
        End If
    Next i
 
    ' Supprimer les lignes dans ClasseurB qui ne sont pas dans ClasseurA
    For j = nbLigB - 1 To 1 Step -1
        If IsError(Application.Match(wsB.Cells(j, 4), wsA.Range("D:D"), 0)) Then
            wsB.Rows(j).Delete
        End If
    Next j
 
    ' Enregistrer et fermer les classeurs
    If Not WorkbookIsOpen(ClasseurA) Then
        wbA.Close SaveChanges:=False
    End If
    If Not WorkbookIsOpen(ClasseurB) Then
        wbB.Close SaveChanges:=True
    End If
End Sub

**edgarrd** · 02/04/2024, 14h49

Envoyé par Franc

Modifications faites.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub Refresh()
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Dim nbLigA As Long, nbLigB As Long, i As Long, j As Long
    Dim ClasseurA As String, ClasseurB As String
    Dim copyRange As Range
 
    ClasseurA = "ClasseurA.xlsx"
    ClasseurB = "ClasseurB.xlsx"
 
    ' Vérifier si les classeurs sont déjà ouverts
    If Not WorkbookIsOpen(ClasseurA) Then
        Set wbA = Workbooks.Open("C:\chemin\vers\ClasseurA.xlsx")
    Else
        Set wbA = Workbooks(ClasseurA)
    End If
 
    If Not WorkbookIsOpen(ClasseurB) Then
        Set wbB = Workbooks.Open("C:\chemin\vers\ClasseurB.xlsx")
    Else
        Set wbB = Workbooks(ClasseurB)
    End If
 
    Set wsA = wbA.Sheets("Feuil1")
    Set wsB = wbB.Sheets("Feuil1")
 
    ' Trouver le nombre de lignes dans chaque feuille de calcul
    nbLigA = wsA.Range("D" & wsA.Rows.Count).End(xlUp).Row
    nbLigB = wsB.Range("D" & wsB.Rows.Count).End(xlUp).Row
 
    ' Si ClasseurB a des données, passer à la ligne suivante
    If nbLigB > 1 Then nbLigB = nbLigB + 1
 
    ' Parcourir les lignes dans ClasseurA
    For i = 1 To nbLigA
        ' Vérifier si l'identifiant client existe dans ClasseurB
        If IsError(Application.Match(wsA.Cells(i, 4), wsB.Range("D:D"), 0)) Then
            ' Copier toute la ligne à ClasseurB si l'identifiant client n'existe pas
            Set copyRange = wsA.Rows(i)
            copyRange.Copy Destination:=wsB.Rows(nbLigB)
            nbLigB = nbLigB + 1
        End If
    Next i
 
    ' Supprimer les lignes dans ClasseurB qui ne sont pas dans ClasseurA
    For j = nbLigB - 1 To 1 Step -1
        If IsError(Application.Match(wsB.Cells(j, 4), wsA.Range("D:D"), 0)) Then
            wsB.Rows(j).Delete
        End If
    Next j
 
    ' Enregistrer et fermer les classeurs
    If Not WorkbookIsOpen(ClasseurA) Then
        wbA.Close SaveChanges:=False
    End If
    If Not WorkbookIsOpen(ClasseurB) Then
        wbB.Close SaveChanges:=True
    End If
End Sub

Brillantissime Franc. J'ai un peu ajuster et ça fonctionne parfaitement.

Je te souhaite une belle journée !

**edgarrd** · 02/04/2024, 15h24

Envoyé par edgarrd

Brillantissime Franc. J'ai un peu ajuster et ça fonctionne parfaitement.

Je te souhaite une belle journée !

J'ai tenté d'optimiser en rafraichissant aussi les données existante en faisant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
    ' Parcourir les lignes dans ClasseurA
    For i = 1 To nbLigA
        ' --------------------------------------------------Vérifier si l'identifiant client existe dans ClasseurB et copie si non présente
        If IsError(Application.Match(wsA.Cells(i, 4), wsB.Range("D:D"), 0)) Then
            ' Copier toute la ligne à ClasseurB si l'identifiant client n'existe pas
            Set copyRange = wsA.Rows(i)
            copyRange.Copy Destination:=wsB.Rows(nbLigB)
            nbLigB = nbLigB + 1
            Else
            Set copyRange2 = wsA.Range("A" & i & ":S" & i)
            Set copyRange3 = wsA.Range("X" & i & ":AR" & i)
            copyRange2.Copy Destination:=wsB.Rows(nbLigB)
            copyRange3.Copy Destination:=wsB.Rows(nbLigB)
            nbLigB = nbLigB + 1
        End If
    Next i

Ca fonctionne pas tellement faut dire, je vais continuer mes recherches

**edgarrd** · 02/04/2024, 16h33

Bon ben mon code ne marche pas...Un petit coup de pouce svp ?

**Franc** · 02/04/2024, 17h57

Dans ton code, copyRange2 et copyRange3 ont la même destination, donc le deuxième va écraser le premier. Modifie comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
copyRange2.Copy Destination:=wsB.Cells(nbLigB, "A")
copyRange3.Copy Destination:=wsB.Cells(nbLigB, "X")

**edgarrd** · 03/04/2024, 08h48

Envoyé par Franc

Dans ton code, copyRange2 et copyRange3 ont la même destination, donc le deuxième va écraser le premier. Modifie comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
copyRange2.Copy Destination:=wsB.Cells(nbLigB, "A")
copyRange3.Copy Destination:=wsB.Cells(nbLigB, "X")

Merci pour ton retour Franc. je test et te reviens. En tout cas merci de ta disponibilité et de ton temps pour moi

**edgarrd** · 03/04/2024, 11h54

Envoyé par edgarrd

Merci pour ton retour Franc. je test et te reviens. En tout cas merci de ta disponibilité et de ton temps pour moi

Je n'arrive pas à comprendre pourquoi ca me recopie le tableau en dessous au lieu de rafraichir en lieu et place des zones ou les id clients sont les mêmes...

**Franc** · 03/04/2024, 12h41

Comme ça je vois pas. Eventuellement, fournis des classeurs test avec le résultat attendu et je vérifierai.

**edgarrd** · 03/04/2024, 13h49

Merci pour ton implication.

Pour résumer disons que j'ai dans le fichier Pilote des managers:
CLIENT - ADRESSE - VEHICULE
123 - 1 rue des Pommes - Porsche
456 - 1 rue des Poires - Twingo
789 - 1 rue des Ceries - Maserati

Le fichier d'un des commercial:
CLIENT - ADRESSE - VEHICULE
123 - 1 rue des Pommes - Porsche
456 - 1 rue des Poires - Twingo

Le premier point que tu as résolu était de rapatrier les clients manquants du fichier pilote manager au fichier du commercial
Le second point était de supprimer une valeur du fichier commercial si, suite à une màj, un client quittait le fichier Pilote manager.

Le troisième point que je tente de résoudre est de mettre à jour tous le fichier commercial a partir du pilote, par example si le client Pilote manager passe de :
CLIENT - ADRESSE - VEHICULE
123 - 1 rue des Pommes - Porsche
456 - 1 rue des Poires - Twingo
789 - 1 rue des Ceries - Maserati

à
CLIENT - ADRESSE - VEHICULE
123 - 1 rue des Pommes - Ferrari
456 - 1 rue des Poires - Twingo
789 - 1 rue des Ceries - Maserati

J'aimerais que ce soit aussi mis à jour dans le fichier commercial, qu'il y ai un changement ou pas. Que quoi qu'il se passe on récupère la data du fichier Pilote Manager et qu'on la mette dans le fichier commercial, sans changer l'emplacement des valeurs du fichiers commercial (car parfois ils font des tries).

Tu vois ce que je veux dire ?

**Franc** · 03/04/2024, 16h33

Ce qu'il me faudrait c'est des classeurs test avec les macros que tu utilises pour voir ce qui cloche, j'ai pas le temps de me créer des classeurs test.

**edgarrd** · 08/04/2024, 14h14

Envoyé par Franc

Ce qu'il me faudrait c'est des classeurs test avec les macros que tu utilises pour voir ce qui cloche, j'ai pas le temps de me créer des classeurs test.

C'est good j'ai trouvé la solution avec un Else et des set Copyrange sur les ranges qui m'intéressaient

**edgarrd** · 08/04/2024, 15h37

Quelqu'un saurait me dire pourquoi j'ai une erreur sur ce code svp:

copyRange2.Copy Destination:=wsB.Range("A" & i & ":A" & i)

Merci d'avance

[VBA Excel] - Copier ligne si un ID pas présent dans annuaire

Macros et VBA Excel

Discussions similaires

Partager

Partager