VBA matcher valeurs d'une feuille à l'autre

**Numenor_Illuvatar** · 26/08/2020, 13h12

Bonjour tout le monde,

Durant la période de confinement j'ai beaucoup travaillé sur VBA pour améliorer les tableaux de bords de mon service.

Cependant je suis bloqué sur un problème depuis maintenant une semaine.

Entre les feuilles, certaines lignes se répètent, et celles qui se répètent possèdent un commentaire dans la colonne A.
Je cherche à transférer ces commentaires dans les lignes correspondantes dans la feuille suivante. Ces lignes ont des positions variables. Exemple si un commentaire se trouve sur la ligne 2 feuille 3, cette même ligne peut se retrouver dans la ligne 5 feuille 4.

Voici la macro que j'ai fait et voici le résultat que ça me donne.. (dans cet exemple le commentaire qui doit être transféré est "ok" mais ça peut être n'importe quelle valeur).

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
Function Previous(ByRef pLigne As Variant) As Variant 'pLigne fait référence au ligne de la feuille précédente
    Dim comm As Variant, ligne As Variant, i As Integer, var As Variant, trouver As Boolean, InRange As Range, Arg As Range
    comm = ActiveSheet.Previous.Cells(Rows.Count, 1).End(xlUp).Row
    For ligne = 2 To comm
        'MsgBox (ligne)
            For i = ActiveSheet.Previous.Index + 1 To Worksheets.Count
            'MsgBox (i)
                trouver = False
                If ActiveSheet.Cells(pLigne, i).Value = ActiveSheet.Previous.Cells(ligne, i).Value Then
                    Previous = ActiveSheet.Previous.Cells(ligne, 1).Value
                Else
                    Exit For
                End If
            Next i
    Next ligne
End Function
 
 
Sub test()
Dim comm As Variant, ligne As Variant, bln As Boolean, isheet As Variant, x As Variant
Dim newcomm As Variant, newligne As Variant, newbln As Boolean, newisheet As Variant
 
 
comm = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
 
For ligne = 2 To comm
    If IsEmpty(Cells(ligne, 1)) Then
 
    'For isheet = ActiveSheet.Index + 1 To Worksheets.Count
        bln = False
        ActiveSheet.Cells(ligne, 1).Value = Previous(ligne)
        'MsgBox (ligne)
    End If
Next ligne
 
End Sub