Transformer des lignes en colonnes

Résolu/Fermé
lahitnihad - 26 juil. 2016 à 21:20
 lahitnihad - 29 juil. 2016 à 15:58
Bonjour,
je suis débutant en VBA et je voudrais copier plusieurs lignes d'une seule ranger par exemple "A" de la feuille 1 en excel et la coller en forme de colonne en feuille 2 mais je ne sais pas comment faire
clairement, je voudrais faire comme l'exemple suivant:

feuille 1:
Ranger: (A1:A6)
AA
BB
CC
DD
EE
FF
feuille2:
AA BB CC
DD EE FF

pouvez vous m'aider?
Mercii
Cordialement,
A voir également:

4 réponses

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
Modifié par gbinforme le 26/07/2016 à 21:42
Bonjour,

Une petite macro toute simple pour un débutant qui utilise quelques notions de base :
Public Sub copier()
Dim col As Long, lig As Long, idx As Long, tbd
tbd = Sheets("Feuil1").UsedRange.Columns(1).Cells.Value
lig = 1: idx = 1
With Sheets("Feuil2")
    While idx <= UBound(tbd)
        For col = 1 To 3
            If idx <= UBound(tbd) Then _
            .Cells(lig, col).Value = tbd(idx, 1)
            idx = idx + 1
        Next col
        lig = lig + 1
    Wend
End With
End Sub


Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer.  Antoine de Saint-Exupéry
0
j'ai bien adaptée votre code a mon cas, et maintenant ça marche très bien.
Mercii beaucoup!!
0
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
26 juil. 2016 à 21:45
Bonjour

Un exemple
http://www.cjoint.com/c/FGAtToUCX5e

Cdlmnt
0
Mercii ça marche très bien,mais j'ai un petit souci,je voudrais copier ces cellules sans la mise en forme ,qu'est ce que je peux faire?
cordialement,
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
27 juil. 2016 à 08:39
Bonjour,

je voudrais copier ces cellules sans la mise en forme ,qu'est ce que je peux faire?
Peut-être essayer la macro que je t'ai mis au-dessus...
0
j'ai déjà essayée votre code, mais j'ai toujours le même problème
0
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
Modifié par ccm81 le 27/07/2016 à 11:37
Tu ajoutes la partie soulignée
Sheets(FB).Cells(liFB, codebFB).PasteSpecial Paste:=xlPasteValues, Transpose:=True

RQ. La proposition de gbinforme (salut à toi au passage), ne copie aussi que les valeurs sans la mise en forme

Cdlmnt
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
27 juil. 2016 à 16:22
Bonjour ccm81,

Effectivement, il y a souvent de multiples façons d'arriver au résultat et j'ai utilisé la table mémoire alors que tu maitrises parfaitement d'habitude : comme quoi cela dépend de l'humeur du moment. ;-)
0
Bonjour,

je voudrais créer la même macro,mais avec un petit changement (saut d'une cellule chaque 3 lignes),voici l'exemple:

Feuille 1:
AA
BB
CC
DD
EE
FF
Feuille 2:
AA BB
DD EE

cordialement,
0
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
29 juil. 2016 à 15:34
Bonjour

' constantes à modifier selon ta configuration
' feuille source
Const FS = "Feuil1"
Const lidebFS = 2
Const coFS = 1
' feuille but
Const FB = "Feuil1"
Const lidebFB = 2
Const codebFB = 3
' nombre de colonnes pour la copie
Const nbco = 2


Public Sub OK()
Dim liFS As Long, lifinFS As Long, plageFS As Range
Dim liFB As Long
Application.ScreenUpdating = False
liFB = lidebFB
With Sheets(FS)
lifinFS = .Cells(Rows.Count, coFS).End(xlUp).Row
liFS = lidebFS
While liFS <= lifinFS
Set plageFS = .Range(.Cells(liFS, coFS), .Cells(liFS + nbco - 1, coFS))
plageFS.Copy
Sheets(FB).Select
Sheets(FB).Cells(liFB, codebFB).PasteSpecial Transpose:=True
liFS = liFS + nbco
liFB = liFB + 1
Wend
End With
Application.ScreenUpdating = True
End Sub


Cdlmnt
0
Mercii infiniment ,ça marche très bien
0