macro Copier Coller

Version imprimable

Voir 40 message(s) de cette discussion en une page

17/03/2009, 18h15
LaPanic

1 pièce(s) jointe(s)

macro Copier Coller

Bonjour,
Je voudrais faire un copier coller sur deux fiechiers differents
Copier la cellule [Classeur1]Feuil1!$B$2 vers [Classeur2]Feuil1!$B$2
les cellules a copier sont sur la colonne B.
Les critéres de selections sont soit les cellules colorées en jaune sur la colonne B ou bien les cellule egales a 1 sur la colonne A.

Merci pour votre aide
17/03/2009, 19h06
bosk1000

bonjour

si j'ai biens compris tu veux copier vers une autre classeurs toutes les cellules jaune de la colonne b et toutes les cellules de la colonne b dont la colonne a à une valeur de 1
c'est a dire une condition si ..couleur jaune .et/ou..cellule a=1
18/03/2009, 08h06
ouisansdoute

Bonjour,

Cette copie doit-elle se faire une fois pour toute ou être automatisée ?

la feuille 1 de ton classeur2 pré-existe-t-elle ou peut-elle être créée à l'occasion de cette opération ?
SI oui tu pourrait utiliser un filtre élaboré qui extraierait les données utiles sur une nouvelle feuille du classeur 1 puis déplacer cette feuille dans le classeur 2.
18/03/2009, 09h57
LaPanic

Bonjour a tous et merci pour vos reponses,

Citation:

bonjour

si j'ai biens compris tu veux copier vers une autre classeurs toutes les cellules jaune de la colonne b et toutes les cellules de la colonne b dont la colonne a à une valeur de 1
c'est a dire une condition si ..couleur jaune .et/ou..cellule a=1

la je voudrai tester les delais de traitement pour pouvoir optimiser si le test de la couleur sur la meme colonne etait plus rapide que le test des 1 sur une autre colonne (voir les deux cas pour ma culture personnelle)

Citation:

Cette copie doit-elle se faire une fois pour toute ou être automatisée ?

la feuille 1 de ton classeur2 pré-existe-t-elle ou peut-elle être créée à l'occasion de cette opération ?
SI oui tu pourrait utiliser un filtre élaboré qui extraierait les données utiles sur une nouvelle feuille du classeur 1 puis déplacer cette feuille dans le classeur 2.

en realité le Classeur1 est un Input en local et le classeur2 est un rapport que je recoie par mail et je dois actualiser quelques cellules et renvoyé par mail
le nom du classeur2 change suivant les versions, ce qui serai le mieu est d'afficher une input box avec un bouton Parcourir qui me permette de selectionner la bonne version du classeur2 et la colonne a actualiser (B,C,D,...)=(Janvier, Fevrier, Mars, ...)
(les deux calsseurs ont les memes noms des feuilles et le meme format)
Merci pour votre aide.

Salut
Regardes si ceci correspond a ton besoin, je regarde pour demander l'emplacement du fichier.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub CopieValeurs()
Dim TheCell As Range
Dim FichierSource As Workbook
Dim FichierDestin As Workbook
 
'On determinera les vrai nom avec une UserForm pour les demander a l'utilisateur
Set FichierSource = Workbooks("Classeur1-1.xls")
Set FichierDestin = Workbooks("Classeur7")
 
With FichierSource.Sheets("Feuil1")
 
    For Each TheCell In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
        If TheCell = "1" Then 'On peut tout aussi bien tester la couleur de la case B c toi qui vois (attetion si couleur optenu par MFC)
            FichierDestin.Sheets("Feuil1").Range(TheCell.Offset(0, 1).Address) = TheCell.Offset(0, 1) 'Si on test directement sur colonne B pour couleur celluleB il faudra supprimer l'Offset
        End If
    Next
End With
End Sub

Ce code doit être placé dans un Module et exécuté avec la touche F5, les 2 classeur doivent être ouverts, la source étant Classeur1-1, la destination Classeur 7
A++
Qwaz

20/03/2009, 08h17
LaPanic

Bonjour,
Merci Qwazerty pour ta reponse, c'est exactement ce que je voulais
il reste trois petits trucs a affiner:
1- j'ai essayé d'integrer cette procedure au debut sauf que je n'ai pas pu changer le fichier de destination en variable

Code:

Application.Workbooks.Open Application.GetOpenFilename()

2- je voudrais mettre une variable au niveau de la colonne de destination(une input box qui me permet de choisir le numero de colonne a copier)

Code:

FichierDestin.Sheets("Feuil1").Range(TheCell.Offset(0, 1).Address) = TheCell.Offset(0, 1)

3-je voudrais etandre la procedure sur toutes les feuilles

merci pour votre aide

Salut
1 - En faite
Application.Workbooks.Open te renvoie un WorkBook, c'est pas facile a voir mais c'est une fonction pas une procédure (donc elle renvoie un résultat).
Une petit astuce pour connaitre ça est de taper sur F2, dans la case recherche en haut a gauche tu tapes "WorkBook" puis rechercher, dans la liste tu recherches la variable WorkBook, tu sélectionne et dans la liste du dessous tu as les propriétés et functions de Workbook, dont Open, si tu cliques sur Open tu as alors sa déclaration, (Open(....)As WorkBook).
Il te suffit donc de faire

Code:

1
2
3
4
5
6
7
OpenFile = Application.GetOpenFilename
If OpenFile <> False Then
    Set FichierDestin = Application.Workbooks.Open OpenFile
Else
    'Pas de fichier sélectionné ou existant -> il faut gérer l'erreur a minima en quittant la procédure
    Exit Sub
End If

[Edit]
2 et 3 )

Code:

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
Sub CopieValeurs()
Dim TheCell As Range, TheSheet As Worksheet
Dim OpenFile
Dim FichierSource As Workbook
Dim FichierDestin As Workbook
Dim NCol 'Declaré en variant
 
'
Set FichierSource = Workbooks("Classeur1-1.xls") 'On peut mettre activeWorkBook si un bouton lance la macro nous permettant d'être sur que l'on se trouve bien sur le bon classeur au lancement de la macro
 
For Each TheSheet In FichierSource.Sheets
    With TheSheet
        OpenFile = Application.GetOpenFilename
        If OpenFile <> False Then
            Set FichierDestin = Application.Workbooks.Open(OpenFile)
        Else
            'Pas de fichier selectionné ou existant -> il faut gérer l'erreur a minima en quittant la procédure
            Exit Sub
        End If
 
        'Demander sur quel colonne travailler
        NCol = InputBox("Dans quelle colonne doivent être placé les résultats ?" & Chr(10) & "Peut être exprimé en chiffre ou en lettre", "Destination?")
        'Peut être une gestion de contenu .. pas facile a faire, puisqu'on va faire en sorte d'accepter un chiffre ou une lettre
 
        For Each TheCell In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
            If TheCell = "1" Then 'On peut tout aussi bien tester la couleur de la case B c toi qui vois (attetion si couleur optenu par MFC)
                FichierDestin.Sheets("Feuil1").Cells(TheCell.Row, NCol) = TheCell.Offset(0, 1) 'Si on test directement sur colonne B pour couleur celluleB il faudra supprimer l'Offset
            End If
        Next
    End With
 
    'On enregistre et on ferme destination?
    FichierDestin.Close True
Next
End Sub

Voila je pense que c ce que tu souhaites.
[/Edit]

A++
Qwaz

2 pièce(s) jointe(s)

Merci beaucoup Qwazerty pour tes reponses t'es un :roi:
j'ai essayé ton code et il y a un petit detail sur lequel je voudrais solliciter ton aide.
le code ne copie que la deuxieme colonne et il s'execute que sur la "Feuil1"et pour cela :

- je voudrai que le code prenne en consideration la feuille active du fichier Source et coller sur la feuille du meme nom dans le fichier cible comme ca je pourrais aussi executer la macro sur Feuil2 du fichier source pour copier et coller les donnés vers Feuil2 du fichier cible et ainsi de suite

- Peut on changer le code ci-dessous:
Code:

1 2 3 'Demander sur quel colonne travailler NCol = InputBox("Dans quelle colonne doivent être placé les résultats ?" & Chr(10) & "Peut être exprimé en chiffre ou en lettre", "Destination?") 'Peut être une gestion de contenu .. pas facile a faire, puisqu'on va faire en sorte d'accepter un chiffre ou une lettre
Voici un exemple precis du fichier source et du resultat dans le fichier cible
les cellules a copier sont l'intersection entre les cellules de la ligne 1:1 ayant la valeur 1 et les cellules de la colonne A:A ayant la valeur 1
et a coller sur les cellules ayant les memes adresses et les memes nom de feuilles respectivement.

Merci pour ton aide
excuses moi de ne pas avoir été claire avant ce poste:oops:

21/03/2009, 08h53
Qwazerty
Salut
En effet on le répète souvent , mais une question et des explications claire dés le départ nous permet de ne pas avoir a reprendre le code plusieurs fois.
Ceci étant dis voici la modification, j'ai continué a prendre en compte une des demandes que tu vais fait sur un poste précèdent a savoir pouvoir le faire sur chaque feuilles, ce que mon code précèdent faisait deja. Ici donc on passe sur toutes les feuilles du fichier, si tu ne veux pas ça et que tu préfères choisir uniquement la feuille sur laquelle tu travailles, il te suffit de désactiver les 2 lignes qui crées la boucle
Code:

1 2 3 For each TheSheet In .... 'Garder ce code Next 'celui tout en bas
Il te restera alors a faire prendre a la variable TheSheet le contenu de la feuille en cours
Code:

1 2 3 4 'For Each TheSheet In ... TheSheet = Source.ActiveSheet With TheSheet '... le reste ne change pas
Voila a++
Qwaz
21/03/2009, 20h15
LaPanic

Merci Qwazerty pour ta reponse

Ca ne marche pas , ca bloque au niveau de la ligne ci-dessous

Code:

TheSheet = Source.ActiveSheet

et je n'ai pas pu tester si il prenait en consideration le nom de la feuille cible

je debute vraiment en VBA et je m'excuse si je n'ai pas su adapter ta proposition.

Merci
22/03/2009, 03h28
Qwazerty
Salut
Autant pour moi
Code:

1 2 Set TheSheet = FichierSource.ActiveSheet
A++
Qwaz

Merci,
j'ai testé le code et la je vois qu'il ne teste pas le nom de la feuille par exemple:
il copie [Source.xls]Feuil2!B4 vers [Cible.xls]Feuil1!B4.
Serait-ce possible d'adapter le code pour qu'il copie les cellules colorées puisque personne n'a donné de solution concernant la question ci-dessous
Code:

1 2 3 4 5 6 7 8 9 - Peut on changer le code ci-dessous: Code : 'Demander sur quel colonne travailler NCol = InputBox("Dans quelle colonne doivent être placé les résultats ?" & Chr(10) & "Peut être exprimé en chiffre ou en lettre", "Destination?") 'Peut être une gestion de contenu .. pas facile a faire, puisqu'on va faire en sorte d'accepter un chiffre ou une lettre Voici un exemple precis du fichier source et du resultat dans le fichier cible les cellules a copier sont l'intersection entre les cellules de la ligne 1:1 ayant la valeur 1 et les cellules de la colonne A:A ayant la valeur 1 et a coller sur les cellules ayant les memes adresses et les memes nom de feuilles respectivement.
je ne sais pas si c'est difficile a programmer si c'est le cas il vaut mieux faire le test sur toutes les cellules colorées

Merci

22/03/2009, 16h56
Qwazerty

Salut
Remplaces

Code:

FichierDestin.Sheets("Feuil1").Cells(TheCell.Row, NCol) = TheCell.Offset(0, 1) 'Si on test directement sur colonne B pour couleur celluleB il faudra supprimer l'Offset

Par

Code:

FichierDestin.Sheets(TheSheet.Name).Cells(TheCell.Row, NCol) = TheCell.Offset(0, 1) 'Si on test directement sur colonne B pour couleur celluleB il faudra supprimer l'Offset

Ainsi les cellule prise dans Source feuil1 seront mise dans destin feuil1, feuil2 dans feuil2 ....

A++
Qwaz
22/03/2009, 19h32
LaPanic

merci ca marche,
concernant la deuxieme partie pour finaliser le code, j'ai demandé a un ami qui m'a conseillé d'utiliser DO ... While pour parcourir la matrice ... un peut trop fort pour moi, est ce qu'il y a quelqu'un pourrait m'aider a concevoir ce code

Merci
22/03/2009, 19h49
Qwazerty

Re
Comment ça une boucle Do.. Wilhe ? Que souhaites tu faire exactement ?
a++
Qwaz

slt,
pour completer le code afin de copier toutes les cellules ayant pour index la la valeur 1 dans la colonne A:A et la valeur 1 dans la ligne 1:1
j'ai mis deux fichier joints dans un post un peut plus haut qui servent pour exemple si je suis la tu as besoin de plus d'explications
Code:

1 2 3 Voici un exemple precis du fichier source et du resultat dans le fichier cible les cellules a copier sont l'intersection entre les cellules de la ligne 1:1 ayant la valeur 1 et les cellules de la colonne A:A ayant la valeur 1 et a coller sur les cellules ayant les memes adresses et les memes nom de feuilles respectivement.
Merci

Salut
Ok il y avait une erreur de logic dans mon code, donc je ne pouvais pas comprendre ta question.
Voila je pense que la macro ainsi réalise ce que tu souhaites

Code:

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
37
38
39
40
41
42
43
Sub CopieValeurs()
Dim TheCell As Range, TheSheet As Worksheet
Dim OpenFile
Dim FichierSource As Workbook
Dim FichierDestin As Workbook
'Dim NCol 'Declaré en variant
Dim TheColCell As Range
 
 
'
Set FichierSource = Workbooks("Source.xls")  'On peut mettre activeWorkBook si un bouton lance la macro nous permettant d'être sur que l'on se trouve bien sur le bon classeur au lancement de la macro
'Set FichierSource = ActiveWorkbook
 
OpenFile = Application.GetOpenFilename
If OpenFile <> False Then
    Set FichierDestin = Application.Workbooks.Open(OpenFile)
Else
    'Pas de fichier selectionné ou existant -> il faut gérer l'erreur a minima en quittant la procédure
    Exit Sub
End If
 
'Demander sur quel colonne travailler
'NCol = InputBox("Dans quelle colonne doivent être placé les résultats ?" & Chr(10) & "Peut être exprimé en chiffre ou en lettre", "Destination?")
'Peut être une gestion de contenu .. pas facile a faire, puisqu'on va faire en sorte d'accepter un chiffre ou une lettre
 
'On boucle sur 1er cellules des colonnes
For Each TheSheet In FichierSource.Sheets
    With TheSheet
        For Each TheColCell In .Range("B1", .Cells(1, Columns.Count).End(xlToLeft))
            If TheColCell = "1" Then
                For Each TheCell In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
                    If TheCell = "1" Then 'On peut tout aussi bien tester la couleur de la case B c toi qui vois (attetion si couleur optenu par MFC)
                        FichierDestin.Sheets(TheSheet.Name).Cells(TheCell.Row, TheColCell.Column) = TheCell.Offset(0, 1) 'Si on test directement sur colonne B pour couleur celluleB il faudra supprimer l'Offset
                    End If
                Next
            End If
        Next
    End With
Next
 
    'On enregistre et on ferme destination?
    FichierDestin.Close True
End Sub

A++
Qwaz

22/03/2009, 20h46
LaPanic

Merci beaucoup
c'est exactement ce que je cherchais, t'es un :king:

je n'arrivais pas a imbriquer deux boucles et j'etais pratiquement convaincu qu'il fallait changer

Code:

TheCell.Offset(0, 1)

parcequ'il renvoyait a la colonne B seulement et je me suis noyé dans le verre d'eau

Merci beaucoup pour ton aide
A+

slt Qwazerty
y a un leger probleme
la macro ne copie pas les bonne valleurs sauf pour la premiere colonne B
et puis elle reporte les memes valeurs de la colonne B sur les autres colonne
ex:
copie valeur B7 du fichier Source vers D7 du fichier Cible au lieu de D7 du fichier Source

je te remecie vivement pour les efforts
22/03/2009, 21h09
Qwazerty

Re
Décidément je bourdasse beaucoup sur ce topic
correction

Code:

FichierDestin.Sheets(TheSheet.Name).Cells(TheCell.Row, TheColCell.Column) = .Cells(TheCell.Row, TheColCell.Column)

++
Qwaz

Merci
Cette fois c'est bon le code marche a merveille, je l'ai adapter a mes fichiers et j'ai triplé la boucle et je voudrais savoir si les delais de traitement peuvent etre optimiser ou pas

Code:

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
37
38
39
40
41
42
43
44
45
46
Sub CopieValeursfinale()
Dim TheCell As Range, TheSheet As Worksheet
Dim OpenFile
Dim FichierSource As Workbook
Dim FichierDestin As Workbook
Dim TheColCell As Range
 
Set FichierSource = Workbooks("Draft budget model 8.xls")
OpenFile = Application.GetOpenFilename
If OpenFile <> False Then
    Set FichierDestin = Application.Workbooks.Open(OpenFile)
Else
    Exit Sub
End If
For Each TheSheet In FichierSource.Sheets
    With TheSheet
        For Each TheColCell In .Range("H1", .Cells(1, Columns.Count).End(xlToLeft))
            If TheColCell = "1" Then
                For Each TheCell In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
                    If TheCell = "1" Then
                        FichierDestin.Sheets(TheSheet.Name).Cells(TheCell.Row, TheColCell.Column) = .Cells(TheCell.Row, TheColCell.Column)
                    End If
                Next
            End If
        Next
        For Each TheColCell In .Range("h1", .Cells(1, Columns.Count).End(xlToLeft))
            If TheColCell = "2" Then
                For Each TheCell In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
                    If TheCell = "2" Then
                        FichierDestin.Sheets(TheSheet.Name).Cells(TheCell.Row, TheColCell.Column) = .Cells(TheCell.Row, TheColCell.Column)
                    End If
                Next
            End If
        Next
        For Each TheColCell In .Range("h1", .Cells(1, Columns.Count).End(xlToLeft))
            If TheColCell = "2" Then
                For Each TheCell In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
                    If TheCell = "1" Then
                        FichierDestin.Sheets(TheSheet.Name).Cells(TheCell.Row, TheColCell.Column) = .Cells(TheCell.Row, TheColCell.Column)
                    End If
                Next
            End If
        Next
    End With
Next
End Sub

Merci beaucoup pour tout

Voir 40 message(s) de cette discussion en une page