VBA Problème copier-coller colonne dans selection sous forme de tableau

Version imprimable

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

21/11/2017, 18h18
RyuAutodidacte

Re,

Je me suis arrêté à ce stade même si il y a des moyens de faire autrement,
car tu a besoin de potasser, au moins déjà pour comprendre le code que j'ai fait …
Donc profites des liens que je t'ai donné pour progresser et potasses bien ;)

Ryu

Bonjour,

Le code ci-dessous (merci Ryu) m'aide beaucoup et j'arrive à l'adapter lorsque je veux alimenter ma base de donnée.
Il permet notamment de trouver la dernière ligne non vide de ma base et d'y ajouter colonne par colonne des données d'un autre onglet.

Cette fois-ci je veux faire quasiment la même opération mais au lieu d'ajouter les colonnes à la suite d'une base de donnée format tableau, je souhaite coller les colonnes juste après une ligne d’entête qui reste fixe (ligne1).

Quant je fais des tests j'arrive à coller les colonnes au bon emplacement mais à chaque fois, soit j'efface l'entête, soit je réécrit dessus...
Autre point, j'ai toujours la première cellule de la colonne que je sélectionne qui disparait au collage.

J'ai oublié... est-ce possible de coller avec le format source? je pense notamment à la couleur car j'ai des cellules surlignées qui ne le sont plus au collage

Merci du coup de main! ;)

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
47
48
49
50
51
52
53
54
55
56
57
58
59
Function Index_Tab(VA As Variant, Entete As Byte, ParamArray Arr()) 'Les paramètres : 1-Variable tableau, 2-Entete (afin de la supprimer ou pas), 3-Array (colonne voulu de la variable tableau, ex : 4, 7, 9)
Dim VB(), i&, j&
    ReDim VB(1 To UBound(VA) - Entete + 1, 1 To UBound(Arr) + 1)
    For i = Entete To UBound(VA)
        For j = 1 To UBound(Arr) + 1:    VB(i - Entete + 1, j) = VA(i, Arr(j - 1)):    Next
    Next
    Index_Tab = VB
End Function
 
Sub BDDFINAL()
 
Dim DL_BDDFACTURE As Long, DL_BDDFINAL As Long, VA As Variant, VB As Variant
 
    DL_BDDFACTURE = Sheets("BDD FACTURE").Cells(Rows.Count, 1).End(xlUp).Row
    VA = Sheets("BDD FACTURE").Range("A3:AG" & DL_BDDFACTURE).Value
 
    DL_BDDFINAL = Sheets("BDD FINAL").Cells(Rows.Count, 1).End(xlUp).Row
 
Application.ScreenUpdating = False
 
    VB = Index_Tab(VA, 1, 1)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 1).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 4)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 2).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 7)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 3).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 3)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 4).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 6)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 5).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 8)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 6).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 9, 10, 11, 12)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 7).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 14, 15, 16, 17)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 11).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 19, 20, 21, 22, 23, 24, 25)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 15).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 27)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 22).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 29)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 23).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
    VB = Index_Tab(VA, 1, 31, 32, 33)
    Sheets("BDD FINAL").Cells(DL_BDDFINAL, 24).Resize(UBound(VB), UBound(VB, 2)).Value = VB
 
Application.ScreenUpdating = True
 
End Sub

30/11/2017, 22h36
RyuAutodidacte

Bonsoir Math971,

Citation:

Il permet notamment de trouver la dernière ligne non vide de ma base …

Je t'ai induit en erreur (avec mon code qui ne va pas sur la 1ère ligne vide , méa culpa) :oops: ~~ou, on s'est mal compris~~ … mais quasi tout le temps quand on veut copier des données, c'est toujours après la dernière ligne (qui elle contient de la donnée).
Donc qui dit dernière ligne dit dernière ligne rempli (que tu appelles d'ailleurs non vide, ce qui est juste); mais cette donnée là tu ne veux pas l'écraser !?
Donc on doit copier sur la 1ère ligne vide (se trouvant juste derrière la dernière ligne "non vide") !

Ce qui donne :

Code:

DL_BDDFINAL = Sheets("BDD FINAL").Cells(Rows.Count, 1).End(xlUp).Row + 1

ou

Code:

DL_BDDFINAL = Sheets("BDD FINAL").Cells(Rows.Count, 1).End(xlUp)(2).Row

Citation:

Cette fois-ci je veux faire quasiment la même opération mais au lieu d'ajouter les colonnes à la suite d'une base de donnée format tableau, je souhaite coller les colonnes juste après une ligne d’entête qui reste fixe (ligne1).

Dans ce cas là tu peux tout simplement indiqué la la ligne où tu commence à copier les données comme cela par exemple :

Code:

Sheets("BDD FINAL").Cells(2, 2).Resize(UBound(VB), UBound(VB, 2)).Value = VB

Sheets("BDD FINAL").Cells(2, 2).Resize(UBound(VB), UBound(VB, 2)).Value = VB (ligne indiqué en rouge, à toi d'indiqué quelle est la colonne de début en vert)

Citation:

Quant je fais des tests j'arrive à coller les colonnes au bon emplacement mais à chaque fois, soit j'efface l'entête, soit je réécrit dessus...
Autre point, j'ai toujours la première cellule de la colonne que je sélectionne qui disparait au collage.

Cf. réponses ci-dessus selon le contexte

Citation:

J'ai oublié... est-ce possible de coller avec le format source? je pense notamment à la couleur car j'ai des cellules surlignées qui ne le sont plus au collage

A ma connaissance, avec une variable tableau, non … mais peut être y a t-il une solution que j'ignore … (mais je n'ai jamais eu ce cas et pour l'instant ma réponse c'est : on ne peut pas)
Pour cela, il faudrait passer par Range.Copy (cf. aide vba).

Après, qu'elle est le contexte qui fait que certaines cellules soit surlignées en jaune ??
On pourrait peut être passé par une MFC sur la feuille pour que cela ce fasse automatiquement …

Citation:

Je t'ai induit en erreur …

je sais pourquoi :

Citation:

Envoyé par RyuAutodidacte

PS : j'ai fait le code à la volé j'ai pas vérifié, dis moi ce qu'il en est …
tu pourras y ajouter les commentaires …

Bonjour Ryu,

Merci pour ton retour! Tout roule! :king:

Ci-dessous les modifs dans le code: en rouge
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 47 48 49 50 Sub BDDFINAL() Dim DL_BDDFACTURE As Long, DL_BDDFINAL As Long, VA As Variant, VB As Variant DL_BDDFACTURE = Sheets("BDD FACTURE").Cells(Rows.Count, 1).End(xlUp).Row VA = Sheets("BDD FACTURE").Range("A2:AG" & DL_BDDFACTURE).Value DL_BDDFINAL = Sheets("BDD FINAL").Cells(Rows.Count, 1).End(xlUp).Row + 1 Application.ScreenUpdating = False VB = Index_Tab(VA, 1, 1) Sheets("BDD FINAL").Cells(2, 1).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 4) Sheets("BDD FINAL").Cells(2, 2).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 7) Sheets("BDD FINAL").Cells(2, 3).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 3) Sheets("BDD FINAL").Cells(2, 4).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 6) Sheets("BDD FINAL").Cells(2, 5).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 8) Sheets("BDD FINAL").Cells(2, 6).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 9, 10, 11, 12) Sheets("BDD FINAL").Cells(2, 7).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 14, 15, 16, 17) Sheets("BDD FINAL").Cells(2, 11).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 19, 20, 21, 22, 23, 24, 25) Sheets("BDD FINAL").Cells(2, 15).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 27) Sheets("BDD FINAL").Cells(2, 22).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 29) Sheets("BDD FINAL").Cells(2, 23).Resize(UBound(VB), UBound(VB, 2)).Value = VB VB = Index_Tab(VA, 1, 31, 32, 33) Sheets("BDD FINAL").Cells(2, 24).Resize(UBound(VB), UBound(VB, 2)).Value = VB Application.ScreenUpdating = True End Sub
Pour mon erreur:"Quant je fais des tests j'arrive à coller les colonnes au bon emplacement mais à chaque fois, soit j'efface l'entête, soit je réécrit dessus..."

Simple erreur d'étourderie... Il était indiqué

Code:

VA = Sheets("BDD FACTURE").Range("A3:AG" & DL_BDDFACTURE).Value

au lieu de

Code:

VA = Sheets("BDD FACTURE").Range("A2:AG" & DL_BDDFACTURE).Value

.

Par rapport aux cellules surlignées en jaunes, elles mettent en avant des cellules que j'ai modifié (correction) volontairement à la main (changement date de livraison par exemple) ou des cellules que j'ai identifié comme importantes à surveiller. C'est un moyen visuel pour moi, et plus simple de les retrouver grâce au tri par couleur.

Encore merci Ryu!

Mathieu

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