Comparer 2 sélections de valeurs et coller 3eme valeur - VBA

Bonjour à toutes et tous,

C'est la première fois que je poste ici car jusqu'à maintenant, j'ai toujours réussi à me débrouiller à l'aide des solutions proposées sur différents problèmes VBA (et un grand merci à toutes ces personnes)!!

Pour ce cas précis, je n'arrive pas à trouver de solution permettant d'obtenir ce que je souhaite... Que je vous explique un peu :

Je souhaite vérifier que les valeurs prises en colonne A,B,C soient les mêmes entre 2 onglets (le mois M-1 et le mois M-2). Si c'est le cas, alors je souhaite copier/coller la valeur de la colonne E associée (3ème partie du programme).

Je sens que la boucle n'est pas bonne, mais je n'arrive pas à trouver une véritable solution ....

Faut-il passer par les tableaux ? Array ? je ne sais pas trop bien ...

En gros, je voudrais que dans l'nglet "201801", je récupère les commentaires de "201712" si jamais entre ces 2 onglets, les valeurs de la colonne A,B et C sont les mêmes et laisser vide autrement.

Sub coflux()

'<<<1>>> Création nouvel onglet

'On paramètre d'abord le mois M-1  et M-2
    If Month(Date) < 10 Then
        ref = Year(Date) & "0" & Month(Date) - 1
    Else
        ref = Year(Date) & Month(Date) - 1
    End If

    'If Month(Date) < 10 Then
        'ref_bis = Year(Date) & "0" & Month(Date) - 2
    'Else
        'ref_bis = Year(Date) & Month(Date) - 2
    'End If

ref_bis = "201712"

'copier coller l'onglet précédent pour garder la mise en page
Sheets.Add after:=Worksheets(Worksheets.Count)
Application.ActiveSheet.Name = ref
ThisWorkbook.Sheets(ref_bis).Range("A1:I8").Copy ThisWorkbook.Sheets(ref).Range("A1")

'On actualise la date dans le nouvel onglet créé
ThisWorkbook.Sheets("201801").Range("B5") = Year(Date)
ThisWorkbook.Sheets("201801").Range("B6") = ref
ThisWorkbook.Sheets("201801").Range("B6").NumberFormat = "#0"

'<<<2>>> Copier coller les alertes depuis le reporting de coflux

'Déclaration des variables utilisées
Dim chemin As String
Dim reporting As Workbook
Dim i As Range
Dim j As Range
Dim k As Range
Dim l As Range
Dim m As Range
Dim n As Range
Dim p As Range
Dim origin As Range
Dim target As Range
Dim origin2 As Range
Dim target2 As Range
Dim comm As Range
Dim final As Range

'Récupération du chemin où est enregistré le reporting de coflux
chemin = "Z:\..........\" & ref

'On va chercher le fichier excel que l'on va utiliser :
Set reporting = Workbooks.Open(chemin & "\.......xls")

'On active le fichier excel:
reporting.Activate

'Condition pour récupérer les alertes seulement sur le périmètre métropole
Set origin = reporting.Sheets("Tableau").Range(Range("A10").Address, Range("A10").End(xlDown).Address)
Set target = ThisWorkbook.Sheets(ref).Range("A9")

For Each i In origin
        If (i.Value = "DOSAINSDQ" Or i.Value = "ACTIFS_BASEDOS" Or i.Value = "DOSAINSFM" Or i.Value = "IMXSICFR7C") Then
            Range(i, i.Offset(0, 10)).Copy
            Range(target, target.Offset(0, 10)).PasteSpecial Paste:=xlPasteValues
            Set target = ThisWorkbook.Sheets(ref).Range(target.Offset(1, 0).Address)
        End If
Next

'On ferme ensuite le fichier de reporting
reporting.Close

'<<<3>>> Comparer les messages d'alertes entre M-2 et M-1 voir certains sont réccurents

' Condition pour comparer la table, la variable et le message d'alerte entre M-1 et M et récupérer le commentaire dans ce cas de figure
Set origin2 = ThisWorkbook.Sheets(ref_bis).Range(Range("A9").Address, Range("C9").End(xlDown).Address)
Set target2 = ThisWorkbook.Sheets(ref).Range(Range("A9").Address, Range("C9").End(xlDown).Address)
Set Comment = ThisWorkbook.Sheets(ref_bis).Range(Range("E9").Address, Range("E9").End(xlDown).Address)
Set comment2 = ThisWorkbook.Sheets(ref).Range("A9")

'/!\ c'est ici que ça bloque !!!

'boucle pour vérifier les valeurs
For Each k In target2
    For Each j In origin2
        If k.Value = j.Value Then
           Range(j, j.Offset(0, 10)).Copy
           Range(comment2, comment2.Offset(0, 10)).PasteSpecial Paste:=xlPasteValues
            Set comment2 = ThisWorkbook.Sheets(ref).Range(comment2.Offset(1, 0).Address)
        End If
    Next
Next

MsgBox "Programme terminé !", vbInformation

End Sub

Merci par avance aux âmes charitables qui pourraient m'aider =D

Salut,

Voici une proposition à placer dans ton code à la place de tout ce qui se trouve entre reporting.close et la msgbox.

Dim LastLineRefBis%, LastLineRef%, q%, r%
Dim TabRefBis As Variant, TabRef As Variant

LastLineRefBis = Sheets(ref_bis).Range("A9").End(xlDown).Row
LastLineRef = Sheets(ref).Range("A9").End(xlDown).Row
TabRefBis = Sheets(ref_bis).Range("A9:E" & LastLineRefBis).Value
TabRef = Sheets(ref).Range("A9:E" & LastLineRef).Value

For q = 1 To UBound(TabRef, 1)
    For r = 1 To UBound(TabRefBis, 1)
        If TabRef(q, 1) & "/" & TabRef(q, 2) & "/" & TabRef(q, 3) = TabRefBis(r, 1) & "/" & TabRefBis(r, 2) & "/" & TabRefBis(r, 3) Then
            Sheets(ref).Range("E" & q + 8) = TabRefBis(r, 5)
            Exit For
        End If
    Next r
Next q

En espérant que cela te convienne.

Jers

Salut Jers,

Merci pour ton rapide retour sur mon problème. C'est tout à fait ce que je souhaitais et cela fonctionne à merveille !

Vous êtes au top sur le forum!! Je vais pouvoir clôturer mon poblème =)

pas de problème

a+