Copier coller entre Classeurs avec conditions

rainbow69006

XLDnaute Occasionnel
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
 

Pièces jointes

  • Copie coller.xls
    18 KB · Affichages: 63
  • Copie coller.xls
    18 KB · Affichages: 63
  • Copie coller.xls
    18 KB · Affichages: 58

Pierrot93

XLDnaute Barbatruc
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....

Code:
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...
 
Dernière édition:

Discussions similaires

Réponses
56
Affichages
905

Statistiques des forums

Discussions
311 707
Messages
2 081 734
Membres
101 809
dernier inscrit
HADER2024