Bonjour à tous !

Je vous sollicite à nouveau car j'aimerais améliorer ma macro ( et je ne trouve pas la solution peut être aurez vous une idée ?

La macro ci dessous compare 2 feuilles et synthétise dans une feuille les écarts, les onglets à comparer sont écrit " en dur" dans la macro et je dois à chaque fois modifier la macro pour comparer des onglets différents.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
 u = Sheets("PDC").Range("A2:CF" & Sheets("PDC").Range("A" & Rows.Count).End(xlUp).Row)
    v = Sheets("PDC_en cours").Range("A2:CF" & Sheets("PDC_en cours").Range("A" & Rows.Count).End(xlUp).Row)

J'aimerais pouvoir sélectionner les onglets à comparer entre eux lorsque je lance ma macro, par exemple : ( PDC vs PDC_202301 ou PDC_202301 vs PDC en cours etc...)

Il y a régulièrement des nouveaux onglets qui sont crées.

Je peux modifier mon onglet synthèse en intégrant des listes (u et v ) ou alors peut être avec un message box qui permet de sélectionner les onglets à comparer ?

Je ne sais pas ce qui est le mieux et surtout pensez vous que cela est possible ?

Code :

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
60
Option Explicit
 
Sub Synthèse()
    Dim u, v, Cel As Range
    Dim dico1 As Object, dico2 As Object
    Dim i As Long, j As Long, lgn As Long, k As Long
 
    Sheets("Synthèse").Select
    Range("A2:CF" & Rows.Count).Clear
    Application.ScreenUpdating = False
    u = Sheets("PDC").Range("A2:CF" & Sheets("PDC").Range("A" & Rows.Count).End(xlUp).Row)
    v = Sheets("PDC_en cours").Range("A2:CF" & Sheets("PDC_en cours").Range("A" & Rows.Count).End(xlUp).Row)
 
    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(u, 1)
        dico1(u(i, 11)) = i
    Next i
 
    Set dico2 = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v, 1)
        dico2(v(i, 11)) = i
    Next i
 
    lgn = 1
    For i = 1 To UBound(u, 1)
        'recopie les lignes de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2
        If dico2.exists(u(i, 11)) = False Then
            Debug.Print "Ajout de 1: " & u(i, 11)
            lgn = lgn + 1
            For j = 1 To UBound(u, 2)
                Sheets("Synthèse").Cells(lgn, j) = u(i, j)
            Next j
        End If
    Next i
 
    For i = 1 To UBound(v, 1)
        If v(i, 11) <> "" Then  '--- contient un ID
            lgn = lgn + 1
            If dico1.exists(v(i, 11)) Then
                k = dico1(v(i, 11)) '--- n° ligne dans feuil1
                Debug.Print u(k, 11) & "<>" & v(i, 11), dico1(v(i, 11)) & "<>" & dico2(v(i, 11))
                'Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
                For j = 1 To UBound(v, 2)
                    Sheets("Synthèse").Cells(lgn, j) = v(i, j)
                    If u(k, j) <> v(i, j) Then
                        Debug.Print "-- " & u(k, j) & " --> " & v(i, j)
                        Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
                    End If
                Next j
            Else
                'Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse
                Debug.Print "Ajout de 2: " & v(i, 11)
                For j = 1 To UBound(v, 2)
                    Sheets("Synthèse").Cells(lgn, j) = v(i, j)
                Next j
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Merci de m'avoir lu et pour votre aide !

A.