Copier coller entre Classeurs avec conditions

[rainbow69006]

Bonjour,

J'aurai besoin d'aide sur la possibilité de faire des copier coller entre classeurs et sous 2 conditions.

J'ai mis un exemple dans le classeur joint.

Merci beaucoup

Slts
Pierre-Jean

 

[Pierrot93]

Re : Copier coller entre Classeurs avec conditions

Re,

remarque, tout n'est peut être pas perdu, peut être qu'en vérifiant uniquement dernière feuille, dont les valeurs sont préalablement placées dans un tabeau virtuul, on pourrait y arriver... dans le code ci dessous, j'ai travaillé sur 3 feuilles dans le même classeur.

Les données d'origine sur la feuil1.
Je vérifie si dans colonne B de feuil1 il y a xxx.
Si c'est le cas les 4 cellules sont placées dans un tableau. Ce même tableau comparé aux valeurs de ma feuil3 (ta feuil2 résultats) contenu dans le tableau t.
Si présent je ne fais rien, sinon copie dans feuil2(ta feuil1 résultats), qui elle sera expurgée des doublons à la fin du process....

Option Explicit
Sub test()
Dim c As Range, x As Long, i As Long, t() As Variant, t2() As Variant
Dim j As Byte, k As Byte, trouve As Boolean
With Sheets("Feuil3")
    t = .Range("A2", .Range("D65536").End(xlUp)).Value
End With
With Sheets("Feuil1")
    For Each c In .Range("B2", .Range("B65536").End(xlUp))
        If c.Value = "xxx" Then
            trouve = False
            t2 = .Cells(c.Row, 1).Resize(1, 4).Value
            For i = 1 To UBound(t, 1)
                k = 0
                For j = 1 To 4
                    If t(i, j) = t2(1, j) Then k = k + 1
                Next j
                If k = 4 Then trouve = True: Exit For
            Next i
            If Not trouve Then .Cells(c.Row, 1).Resize(1, 4).Copy Sheets("Feuil2").Range("A65536").End(xlUp)(2)
            Erase t2
        End If
    Next c
End With
With Sheets("Feuil2")
    x = .Range("A65536").End(xlUp).Row
    .Range("A1:D" & x).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    For i = x To 1 Step -1
        If .Rows(i).Hidden Then .Rows(i).Delete
    Next i
    If .FilterMode Then .ShowAllData
End With
End Sub

Je te laisse rajouter les noms des classeurs dans le code ains que l'adaptation des feuilles...

En espérant avoir été clair et que cela fonctionne comme tu le souhaite...

Bon tests...

 

[Pierrot93]

Re : Copier coller entre Classeurs avec conditions

Bonjour,

attention, j'ai modifié le code ce matin, j'ai inversé les instructions sur cette ligne :
"If k = 4 Then trouve = True: Exit For"
bonne journée
@+