VBA : Récupérer les valeurs d'un objet dans un autre objet

Version imprimable

23/06/2020, 03h33
WiwiBear

VBA : Récupérer les valeurs d'un objet dans un autre objet
Bonjour tout le monde,
Je galère un peu (beaucoup) sur une récupération de valeur d'un objet et les mettre dans un second objet.

Point de départ :
Les 10 valeurs de ~~E1 à E10~~ E1 à N1:
AAA BBB CCC DDD EEE FFF GGG HHH III JJJ

Je récupère ces 10 valeurs dans l'objet Plage01, ce qui doit donner ceci :

Code:

Set Plage01=Cells(1,5).Resize(1,10)

Je voudrais récupérer 4 valeurs de Plage01 (dont certaines non contiguës) et les mettre dans un seconde objet,
puis les "coller" sur ~~H10:H13~~ H10:K10
Si possible en utilisant que Cells et pas Range
Code:

1 2 Set Plage02= ??? Sheets("feuille").Cells(10,10).Resize(1,3) = Plage02.Value
Résultat attendu sur ~~H10:H13~~ H10:K10 :
BBB FFF GGG III

J'ai fait des tests avec Union mais ça n'a rien donné...

Auriez-vous une idée ?
Merci.

Bonjour,

Le plus simple, sélectionnez les cellules de votre choix et cliquez sur le bouton pour recopier sur l'autre feuille.
le code

Code:

1
2
3
4
5
6
7
8
Sub Selectionner_coller()
    Lig = 10 'première ligne vide de la feuille de destination
    For Each cell In Selection
        Sheets("Dest").Cells(Lig, "H") = cell
        Lig = Lig + 1
    Next
    Sheets("Dest").Select
End Sub

autre code possible

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Selectionner_coller_2()
    Lig = 10 'première ligne vide de la feuille de destination
    Nbre = Selection.Count
    ReDim valeur(Nbre) As String
    i = 1
    For Each cell In Selection
        valeur(i) = cell
        i = i + 1
    Next
    Sheets("Dest").Select
    Cells(Lig - 1, "H").Resize(Nbre + 1, 1) = Application.Transpose(valeur)
End Sub

le fichier en exemple (avec le premier code)
Pièce jointe 573510

le rendu
Pièce jointe 573511

Cdlt

23/06/2020, 07h52
Philippe Tulliez

Bonjour Arturo,
Pourquoi un boucle ?
La simple méthode Copy avec l'argument Destination suffit amplement

Code:

Selection.Copy Destination:=Range("L2")

Ce que l'on peut faire manuellement est possible avec VBA
23/06/2020, 09h07
Menhir
Citation:

Envoyé par WiwiBear

J'ai fait des tests avec Union mais ça n'a rien donné...

Je ne sais pas comment tu as utilisé Union mais ceci fonctionne :
Code:

1 2 Set Plage02 = Union(Plage01.Cells(2, 1), Plage01.Cells(6, 1), Plage01.Cells(7, 1), Plage01.Cells(9, 1)) Plage02.Copy Sheets("feuille").Cells(10, "H")
23/06/2020, 09h26
WiwiBear

Merci pour vos réponses.
Je teins à m'excuser j'ai fais une erreur dans mon énoncé (corrigé) j'ai confondu ligne et colonne (il était tard et je devais plus avoir les idée très claires)

@ARTURO83 vraiment désolé pour mon erreur :oops:, du coup ton code n'est plus valide (en plus t'as fait une réponse super claire)

@Philippe Tulliez je préfère éviter cette méthode, il me semble qu'elle est moins rapide (et pas adapté à mon besoin)

@Menhir lors de mes tests j'avais fait quelque chose qui ressemblait grandement à ce que tu as fait, mais ça fonctionnait pas, je vais retester

Les 2 codes modifiés (au choix)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Selectionner_coller()
    Col = 8 'première ligne vide de la feuille de destination
    For Each cell In Selection
        Sheets("Dest").Cells(10, Col) = cell
        Col = Col + 1
    Next
    Sheets("Dest").Select
End Sub
 
Sub Selectionner_coller_2()
    Col = 8 = 10 'première ligne vide de la feuille de destination
    Nbre = Selection.Count
    ReDim valeur(Nbre) As String
    i = 1
    For Each cell In Selection
        valeur(i) = cell
        i = i + 1
    Next
    Sheets("Dest").Select
    Cells(10, 7).Resize(1, Nbre + 1) = valeur()
End Sub

23/06/2020, 09h47
Philippe Tulliez

Bonjour,

Citation:

@Philippe Tulliez je préfère éviter cette méthode, il me semble qu'elle est moins rapide (et pas adapté à mon besoin)

Copy moins rapide ? il faudra m'expliquer
Pas adapté à vos besoins ? Difficile à confirmer avec les informations que l'on a reçues

1 pièce(s) jointe(s)

Histoire d'être moins brouillon, je vous ai fourni le fichier avec la macro : Pièce jointe 573523

ARTURO83 je vais regarder ta proposition (encore merci)

Mon test avec Union qui ne fonctionne pas :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub test() Dim Plage01 As Range Dim Plage02 As Range Set Plage01 = Sheets("Feuille").Cells(1, 5).Resize(1, 10) Set Plage02 = Union(Plage01.Cells(1, 2), Plage01.Cells(1, 6), Plage01.Cells(1, 7), Plage01.Cells(1, 9)) ThisWorkbook.Sheets("Feuille").Cells(10, 8).Resize(1, 4) = Plage02.Value Set Plage01 = Nothing Set Plage02 = Nothing End Sub
Renvoi :
BBB BBB BBB BBB

Au lieu de :
BBB FFF GGG III

23/06/2020, 11h21
Menhir
Citation:

Envoyé par WiwiBear

Mon test avec Union qui ne fonctionne pas :

Ca ne peut pas fonctionner avec une simple assignation par "=".
C'est pour ça que j'ai utilisé un Copy dans le code fourni.

Si le but est de ne copier que les valeurs, tu peux procéder ainsi :
Code:

1 2 3 Set Plage02 = Union(Plage01.Cells(2, 1), Plage01.Cells(6, 1), Plage01.Cells(7, 1), Plage01.Cells(9, 1)) Plage02.Copy Sheets("feuille").Cells(10, "H").PasteSpecial(xlPasteValues)

1 pièce(s) jointe(s)

Menhir,
C'est parfait !

Au final ça donne ceci : Pièce jointe 573543

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test()
 
Dim Plage01 As Range
Dim Plage02 As Range
 
Set Plage01 = Sheets("Feuille").Cells(1, 5).Resize(1, 10)
 
Set Plage02 = Union(Plage01.Cells(1, 2), Plage01.Cells(1, 6), Plage01.Cells(1, 7), Plage01.Cells(1, 9))
 
Plage02.Copy
Sheets("Feuille").Cells(10, 8).PasteSpecial (xlPasteValues)
 
Set Plage01 = Nothing
Set Plage02 = Nothing
 
End Sub

Merci beaucoup ! :ccool:
Et merci à tous ceux qui se sont penchés sur mon problème.