Copier coller entre Classeurs avec conditions

Pierrot93

XLDnaute Barbatruc
Re : Copier coller entre Classeurs avec conditions

Bonjour,

tu bloques où ? je ne vois pas le début d'un code dans ton fichier... Ce forum n'a pas vocation à fournir des applis clés en main... plutôt être une aide à progresser... depuis le temps que tu viens....

bonne journée
@+
 

rainbow69006

XLDnaute Occasionnel
Re : Copier coller entre Classeurs avec conditions

J'ai essayé ca pour commencer (ca ne fais pas tout ce que je veu faire) mais ca ne fonctionne pas non plus :) ... errreur de format different de cellules...

Pour répondre à toi Pierrot93 (Qui m'a deja aidé sur certains de mes projets d'ailleurs :) )

Quand je me lance sur un projet je le divise en plein de partie différente.
- La mjorité des parties je sais les faire (Je reprend des anciens projets sur lesquels on m'a aidé et je les modifient pour fonctionner avec mon nouveau projet.)
- Quand je sais pas faire, je demande, parfois j'ai un début de code, parfois comme là, je n'ai rien . ou quel que chose qui a mon avis ne va pas servir à celui qui va m'aider du coup je le met pas...

Merci
Slts
 

Fichiers joints

rainbow69006

XLDnaute Occasionnel
Re : Copier coller entre Classeurs avec conditions

Bon la première ligne est completement inutile

Private Sub CommandButton1_Click()
Workbooks("classeur2.xls").Worksheets("feuil1").Cells.Copy _
Workbooks("copie coller.xls").Worksheets("feuil1").Range("A2")
Workbooks("classeur2.xls").Close False
End Sub
 

Pierrot93

XLDnaute Barbatruc
Re : Copier coller entre Classeurs avec conditions

Re,

pour t'aider à avancer, un essai ci-dessous, nom des feuilles à adapter, rajouter le nom des classeurs devant les "sheets", les 2 classeurs sont ouverts, je te laisse adapter à ton projet... :
Code:
Option Explicit
Sub test()
Dim c As Range, x As Long, i As Long
With Sheets("Feuil1")
    For Each c In .Range("B2", .Range("B65536").End(xlUp))
        If c.Value = "xxx" Then
            .Cells(c.Row, 1).Resize(1, 4).Copy Sheets("Feuil2").Range("A65536").End(xlUp)(2)
        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
    .ShowAllData
End With
End Sub
 

rainbow69006

XLDnaute Occasionnel
Re : Copier coller entre Classeurs avec conditions

Re,

Dans ce code, pouvez vous m'expliquezpourquoi cette condition?
Code:
If c.Value = "xxx" Then
Je n'ai pas compris non plus la deuxième partie du code
Code:
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
    .ShowAllData
End With
Voila le code avec les classeurs. Une erreur s'affiche "l'indice n'appartient pas à la selection.

Code:
Option Explicit


Private Sub CommandButton1_Click()
Dim c As Range, x As Long, i As Long
Workbooks.Open Filename:="C:\nouveau dossier\données sources.xls"

With Workbooks("données sources.xls").Worksheets("feuil1")
    For Each c In .Range("B2", .Range("B65536").End(xlUp))
        If c.Value = "xxx" Then
            .Cells(c.Row, 1).Resize(1, 4).Copy Workbooks("resultat.xls").Worksheets("feuil1").Range("A65536").End(xlUp)(2)
        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
    .ShowAllData
End With

Workbooks("donnés sources.xls").Close False
End Sub
 

Fichiers joints

Pierrot93

XLDnaute Barbatruc
Re : Copier coller entre Classeurs avec conditions

Re,

If c.Value = "xxx" Then
permet de tester la valeur des cellules de la colonne B...

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
.ShowAllData
End With
comme la copie est faite systèmatiquement, à la fin de la procédure ces instructions permettent d'effacer les doublons par utilisation du filtre élaboré...


Voila le code avec les classeurs. Une erreur s'affiche "l'indice n'appartient pas à la selection.
D'après ce message, un nom de feuille ou un nom de classeur est erroné....
 

rainbow69006

XLDnaute Occasionnel
Re : Copier coller entre Classeurs avec conditions

Oups oui j'avais une faute de frappe..

Maintenant j'ai une autre erreur methode allshowdata de la classe à echoué

Et si je supprime le 2ème paragraphe pour éviter d'avoir l'erreur, rien n'est copié. Alors que ca devriat quand même copier non? (Avec des doublons)

Slts
Pierre
 

Fichiers joints

Pierrot93

XLDnaute Barbatruc
Re : Copier coller entre Classeurs avec conditions

Re,

peut être faire un test en modifiant cette instruction comme suit :
Code:
    If .FilterMode Then .ShowAllData
 

rainbow69006

XLDnaute Occasionnel
Re : Copier coller entre Classeurs avec conditions

Re,

Super presqua ca. ca marche bien. Mais pour le moment ca verifie si la ligne n'existe pas dans la feuill1 mais il faudrait que cela verifie en feuil1 et en feuil2.

en gros avoir un peu quelque chose comme ca? :
With Workbooks("resultat.xls").Worksheets("feuil1") And .Worksheets("feuil2")
 

Pierrot93

XLDnaute Barbatruc
Re : Copier coller entre Classeurs avec conditions

Re,

il faut effectuer 2 fois la copie, une fois sur la feuille 1 et une autre fois sur la feuille 2..... et lancer 2 fois le filtre élaboré, feuilles 1 et 2...
 

rainbow69006

XLDnaute Occasionnel
Re : Copier coller entre Classeurs avec conditions

Re,

j'aimerais que ca verifie la feuil1 et 2, mais que ca copie les données de l'autre classeur que en page 1 et pas en page 2

J'ai essayé ça mais j'ai une erreur 1004.

Code:
Option Explicit


Private Sub CommandButton2_Click()
Dim c As Range, x As Long, i As Long
Workbooks.Open Filename:="C:\nouveau dossier\données sources.xls"

With Workbooks("données sources.xls").Worksheets("feuil1")
    For Each c In .Range("B2", .Range("B65536").End(xlUp))
        If c.Value = "xxx" Then
            .Cells(c.Row, 1).Resize(1, 4).Copy Workbooks("resultat.xls").Worksheets("feuil1").Range("A65536").End(xlUp)(2)
        End If
    Next c
End With

With Workbooks("resultat.xls").Worksheets("feuil1")
    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


With Workbooks("resultat.xls").Worksheets("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

Workbooks("données sources.xls").Close False

End Sub
Slts
Pierre
 

Pierrot93

XLDnaute Barbatruc
Re : Copier coller entre Classeurs avec conditions

Re,

pas tout compris, en l'état tes données ne sont copiées que sur "Workbooks("resultat.xls").Worksheets("feuil1")"
 

rainbow69006

XLDnaute Occasionnel
Re : Copier coller entre Classeurs avec conditions

Oui, c'est ce que je veu.

Je veu que ca copie les données ici: "Workbooks("resultat.xls").Worksheets("feuil1" )"

Mais que ca vérifie:
ici: "Workbooks("resultat.xls").Worksheets("feuil1" )"
et ici: "Workbooks("resultat.xls").Worksheets("feuil2" )"
que les données n'existe pas deja (afin de ne pas crer de doublons dans le classeur.)
 

Pierrot93

XLDnaute Barbatruc
Re : Copier coller entre Classeurs avec conditions

Re,

mal parti, car ici on ne vérifie pas... on copie systèmatiquement vers une seule feuille et ensuite on expurge cette même feuille des doublons..... je crains qu'il faille revoir ta copie afin de faire les vérifications sur les 2 feuilles avant de faire la copie....
 

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:

Pierrot93

XLDnaute Barbatruc
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
@+
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas