Copier-Coller des Cellules choisies par l'utilisateur

Le 14/02/2021 à 22:22

Bonjour à tous,

Je débute en VBA et voilà mon soucis: J'ai 2 fichiers Excel A et B, je voudrais choisir des cellules (Non pas dans figées dans le code VBA) dans mon FichierA et et les faire correspondre à certaines cellules de mon FichierB.

Exemple: Dans mon FichierA je fais CTRL+ B2+ C2+L2 et avec un Bouton les données contenues dans ces cellules(B2,C2 et L2) aillent dans mon FichierB dans les cellules C4,F4,K4.

Merci d'avance!

Le 14/02/2021 à 23:15

Bonjour,

Pouvez-vous donner des précisions ? Est-ce que les 2 classeurs seront ouverts ? Si oui, lequel doit contenir le code ? Quelles sont les feuilles concernées dans chaque classeur ? Ou vont les cellules dans le classeur B (toujours en C, F et K) ?

Vous voulez les valeurs uniquement ?

Cdlt,

Le 14/02/2021 à 23:49

Bonjour,

Les 2 classeurs sont ouverts, c’est le classeurA qui doit contenir le code, dans le classeurA c’est la feuille « projets »qui est concernée et dans le classeurB c’est la feuille « Form1 ».

La copie doit se faire des cellules du classeurA vers le classeurB.

Problème: les cellules du ClasseurA de la feuille Projets qui doivent être collées dans le classeurB feuille Form1 ne sont pas figées ni connues d’avance. Elles peuvent varier

Merci beaucoup

Le 15/02/2021 à 00:58

Bonjour,

Voici un premier essai avec une incertitude au niveau de la destination des cellules et, dans le doute, le collage des valeurs uniquement.

Sub Transferer()

set wsDest = workbooks("classeurB.xlsm").sheets("Form1") 'ADAPTER NOMS
set wsSource = thisworkbook.sheets("Projets") 'ADAPTER NOM (thisworkbook est le classeurA)

if wsSource.selection.count <> 3 then exit sub 'si sélection diff de 3 cellules, sortie
if msgbox("Exporter ?", vbyesno) <> vbyes then exit sub

with wsDest
    nvl = .cells(.rows.count, 3).end(xlup).row + 1 '1ere vide en C pour coller à la suite...
    for each cell in wsSource.selection.cells 'pour chaque cellule de la sélection
        n = n + 1 'incrémentation
        j = choose(n, 3, 6, 11) 'colonnes correspondantes
        .cells(nvl, j).value = cell.value 'copie valeur
    next cell
end with

end sub

La plage d'origine ne pose pas de problème, c'est la sélection. En revanche, la destination doit être définie avec soin...

Cdlt,

Le 15/02/2021 à 09:20

Bonjour 3GB,

Merci pour les premiers inputs, pour plus de précisions:

Le classeur source est "DA OCT NOV DEC, feuille Form1", et les Cellules à transférer vers le classeur "Dashboard v1.2 2021-S05, feuille Projets" ne sont pas connues d'avance, elles ne sont pas figées.

Mais les Cellules ("Dashboard v1.2 2021-S05, feuille Projets") de destination vont de la colonne A à N à partir de la première ligne vide.

Encore mercii

Le 15/02/2021 à 14:47

Bonjour Nguil,

C'est toujours pas assez précis pour la destination. As-tu fait des essais au moins ? Je peux adapter la macro mais ça ne changera pas grand-chose et il vaut mieux que ce soit toi qui adaptes (surtout les noms de classeur), n'ayant pas accès à ton ordinateur.

En cas de bug, merci de m'indiquer la ligne (surlignée en jaune lors du débogage) et le message, sachant que le risque principal porte sur les noms des classeurs et le fait qu'il soient ouverts ou non...

Cdlt,

Le 16/02/2021 à 09:01

Bonjour 3GB,

J'ai adapté le code en précisant la source et la destination.

En exécutant j'ai l'erreur suivante :"Propriété ou méthode non gérée par cet objet" et la ligne concernée est "If wsSource.Selection.Count <> 3 Then Exit Sub 'si sélection diff de 3 cellules, sortie".

Voilà le genre de correspondance que je voudrais avoir:

Source --> Destination:

A ---> N : 1ere cellule de la colonne "A" correspond à la 1ere cellule de la colonne "N"

B --->A

C ---> O

F ---> C

Sub Transferer()

Set wsDest = Workbooks("Dashboard v1.2 2021-S05.xlsx").Sheets("Projets") 'ADAPTER NOMS

Set wsSource = ThisWorkbook.Sheets("Form1") 'ADAPTER NOM (thisworkbook est le classeurA)

If wsSource.Selection.Count <> 3 Then Exit Sub 'si sélection diff de 3 cellules, sortie

If MsgBox("Exporter ?", vbYesNo) <> vbYes Then Exit Sub

With wsDest

nvl = .Cells(.Rows.Count, 3).End(xlUp).Row + 1 '1ere vide en C pour coller à la suite...

For Each cell In wsSource.Selection.Cells 'pour chaque cellule de la sélection

n = n + 1 'incrémentation

j = Choose(n, 3, 6, 11) 'colonnes correspondantes

.Cells(nvl, j).Value = cell.Value 'copie valr

Next cell

End With

End Sub

Merci beaucoup!

Le 16/02/2021 à 12:33

Bonjour,

Oui, en effet, l'objet Selection est un objet d'application et non une propriété de feuille... Voici un nouvel essai :

Sub Transferer()

Set wsDest = Workbooks("Dashboard v1.2 2021-S05.xlsx").Sheets("Projets") 'ADAPTER NOMS

if typename(Selection) = "Range" then set r = Selection else exit sub
if r.parent.name <> "Form1" then exit sub 'or r.count > 4...
If MsgBox("Exporter ?", vbYesNo) <> vbYes Then Exit Sub

With wsDest
    nvl = .Cells(.Rows.Count, 3).End(xlUp).Row + 1 '1ere vide en C pour coller à la suite...
    For Each cell In r.Cells 'pour chaque cellule de la sélection
        col = cell.column
        j = switch(col = 1, 14, col = 2, 1, col = 3, 15, col = 6, 3) 'colonnes correspondantes
        if not isnull(j) then .Cells(nvl, j).Value = cell.Value 'copie valr
    Next cell
End With

End Sub

C'est assez peu courant comme macro... Ce qui me chagrine, c'est que j'ai l'impression qu'on pourrait automatiser cela (en fonction d'un critère ou en prenant toujours la dernière ligne) sans sélection et ce serait beaucoup plus simple.

Le 17/02/2021 à 08:41

Merci beaucoup 3GB, c'est exactement ce que je voulais !

Merci pour le secours!

Le 15/03/2021 à 09:24

Bonjour 3GB, encore moi ^^

J'ai un soucis de machting entre ma feuille sourse "Donnes_Brutes" et ma feuille destination ("Dashboard v1.2 2021-S05.xlsx").Sheets("Projets").

Lorsque j'exécute le code, certaines données de la source sont décalées d'une cellule vers le bas. Par exemple si dans ma source j'ai:

image

En exécutant le code voilà ce que j'obtiens dans la destination:

image

Voici le code:

Sub Transferer()

Set wsDest = Workbooks("Dashboard v1.2 2021-S05.xlsx").Sheets("Projets") 'ADAPTER NOMS

If TypeName(Selection) = "Range" Then Set r = Selection Else Exit Sub
If r.Parent.Name <> "Donnees_Brutes" Then Exit Sub 'or r.count > 4...
If MsgBox("Exporter vers Dashboard ?", vbYesNo) <> vbYes Then Exit Sub

With wsDest

    nvl = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '1ere vide en A pour coller à la suite...
        For Each cell In r.Cells
            col = cell.Column
        j = Switch(col = 1, 14, col = 5, 1, col = 6, 30, col = 7, 16, col = 8, 23, col = 9, 19, col = 10, 3, col = 11, 25, col = 12, 18) 'colonnes correspondantes
        If Not IsNull(j) Then .Cells(nvl, j).Value = cell.Value 'copie valr

    Next cell

End With

End Sub

peux-tu m'aider à faire une copie ligne par ligne stp?

Merci d'avance

Le 15/03/2021 à 09:51

Salut Nguil,

Avec le code que tu as, ce n'est pas normal que tu obtiennes ce résultat. Donc, ce n'est pas ce code qui est en cause mais un autre...

D'ailleurs, dans le code en question, il n'y a aucune valeur collée en J et K (colonnes 10 et 11). En revanche, il y a des valeurs provenant des colonnes J et K de la source collées en C et Y de la destination.

En tout cas, je dirais qu'il suffit d'adapter le switch à ta convenance pour que ça marche.

Et si jamais ça persistait, cela signifierait qu'il y a une macro évènementielle (worksheet_change) sur la feuille de destination qui crée ce décalage...

Cdlt,

Le 22/03/2021 à 08:38

Bonjour 3GB,

D'abord merci pour tes retours.

Mais je pense que le problème vient de la ligne:

If Not IsNull(j) Then .Cells(nvl, j).Value = cell.Value

Car la condition "If" ne gère pas le cas où IsNull est vide. En effet, certaines cellules de peuvent etre vides dans ma selection.

Du coup j'ai pensé faire un "Else" après le "If" mas je ne sais comment le faire.

Peux-tu m'aider stp?

Le 22/03/2021 à 21:43

Salut Nguil,

Tu sais, je pense que tu aurais dû faire des essais directement et revenir vite vers moi car c'est compliqué de se replonger dans un problème passé...

Je vais expliquer mon code du 16/2/21 à 12h33 et je te renvoie à ce commentaire où j'exprimais mon interrogation sur l'utilité d'une telle macro (inhabituelle). C'est toujours d'actualité. Peut-être que tu n'as pas envisagé toutes les possibilités, certaines permettraient certainement de tout automatiser.

Sub Transferer()
'Les commentaires suivent les lignes de code ----

Set wsDest = Workbooks("Dashboard v1.2 2021-S05.xlsx").Sheets("Projets")
'affectation de la variable wsDest par la feuille "Projets" (la destination) du classeur "Dash..."

if typename(Selection) = "Range" then set r = Selection else exit sub
'si la sélection est une plage, affectation de r par cette plage (la source), sinon sortie
if r.parent.name <> "Form1" then exit sub
'si la feuille source n'est pas nommée "Form1", sortie
If MsgBox("Exporter ?", vbYesNo) <> vbYes Then Exit Sub
'msg de confirmation

With wsDest
'avec la feuille de destination
    nvl = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
    'nvl prend le numéro de ligne de la première cellule vide en colonne C
    For Each cell In r.Cells
    'pour chaque cellule de la sélection (source)
        col = cell.column
        'col prend le numéro de colonne de la cellule en cours
        j = switch(col = 1, 14, col = 2, 1, col = 3, 15, col = 6, 3)
        'j recoit un numéro de colonne dépendant de col (si col =1, j = 14 ; si col = 2, j = 1 ; ...)
        '!!!! si col n'appartient pas à l'ensemble des possibilités du switch (ni 1, ni 2, ni 3, ni 6), alors j vaut null !!!
        if not isnull(j) then .Cells(nvl, j).Value = cell.Value 'copie valr
        'if j ne vaut pas null (cad si j est bien un numéro de colonne résultant du switch), la cellule à la première ligne vide en colonne j sur la feuille de destination vaut la valeur de la cellule en cours de la sélection (de la source)
    Next cell
    'on passe à la cellule suivante
End With

End Sub

Ici, j est un numéro de colonne. En aucun cas, j ne dépend de la valeur d'une cellule (j dépend de la colonne de la cellule source) et en aucun cas j ne peut valoir "" (j vaut un des numéros de colonne issus du switch ou, à défaut de correspondance avec col, j vaut null).

D'ailleurs, je ne sais pas vraiment quel est ton problème en fin de compte ?!! Si tu as envie de le résoudre, décris-le moi en joignant un fichier, ce sera plus simple.

Enfin, comme je te l'ai déjà dit, j'aurais tendance à parier - à moins que tu aies procédé à des modifications du code - qu'il y a une macro évènementielle qui perturbe le résultat de cette macro. Il faut donc regarder le code dans le module Projets du classeur "Dashboard..." (ou le module thisworkbook de ce même classeur).

Voici donc un nouveau code à essayer pour vérifier cette hypothèse :

Sub Transferer()

Set wsDest = Workbooks("Dashboard v1.2 2021-S05.xlsx").Sheets("Projets") 'ADAPTER NOMS

If TypeName(Selection) = "Range" Then Set r = Selection Else Exit Sub
If r.Parent.Name <> "Donnees_Brutes" Then Exit Sub 'or r.count > 4...
If MsgBox("Exporter vers Dashboard ?", vbYesNo) <> vbYes Then Exit Sub

With wsDest

    nvl = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '1ere vide en A pour coller à la suite...
        For Each cell In r.Cells
            col = cell.Column
        j = Switch(col = 1, 14, col = 5, 1, col = 6, 30, col = 7, 16, col = 8, 23, col = 9, 19, col = 10, 3, col = 11, 25, col = 12, 18) 'colonnes correspondantes
        application.enableevents = false
        If Not IsNull(j) Then .Cells(nvl, j).Value = cell.Value 'copie valr
        application.enableevents = true
    Next cell

End With

End Sub

Cdlt,

Rechercher des sujets similaires à "copier coller choisies utilisateur"