Macro copie colle transpose dans un tableau

Bonjour tout le monde,

Un mini coup de pouce salvateur pour un débutant s'il vous plaît :

Sub CopieTranspose ()

Dim C As Worksheet 'déclare la variable C (onglet Comparaison)
Dim T As Worksheet 'déclare la variable T (onglet Tableau)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set C = Sheets("Feuil1") 'définit l'onglet C
Set T = Sheets("Feuil2") 'définit l'onglet T
Set DEST = T.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
C.Range("F1:F5").Copy 'copie la plage F
DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True 'colle les valeurs de la plage dans DEST en transposant

End Sub

J'arrive à faire fonctionner la macro sans tableau. Quand je répète la macro, une autre ligne s'ajoute etc, et c'est parfait.

Maintenant quand j'ajoute un tableau, ça me met les données dans la première ligne juste en dessous du tableau, et je n'arrive pas à l'insérer dans le tableau.

Sauf si je mets le .Offset(0,0)

Mais si je fais ça, impossible ensuite d'ajouter des lignes dans le tableau...

Comment faire ?

Merci beaucoup à vous par avance.

Germain

hello,

t'entends quoi par tableau ? un tableau "type excel" ?

tu devrais joindre un fichier exemple

Hello Rag,

Un tableau "insertion mise en forme" ce qu'il y a de plus simple!

Voilà le fichier sur lequel je m'entraîne.

Merci à toi pour ton aide

Germain

52copietranspose.xlsm (22.21 Ko)

Hello,

Sub CopieTranspose()

Dim C As Worksheet 'déclare la variable C (onglet Comparaison)
Dim T As Worksheet 'déclare la variable T (onglet Tableau)
Dim lr As ListRow

Set C = Sheets("Feuil1") 'définit l'onglet C
Set T = Sheets("Feuil2") 'définit l'onglet T

Set lr = ActiveSheet.ListObjects(1).ListRows.Add
C.Range("F1:F5").Copy
lr.Range.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

End Sub

Bonjour,
Une autre proposition pour faire le job.
Cdlt.

Public Sub CopieTranspose()
Dim ws As Worksheet, lo As ListObject, tbl As Variant, r As Range

    Set ws = Worksheets("Feuil1")
    Set lo = Worksheets("Feuil2").Range("Tableau1").ListObject

    tbl = ws.Range("F1:F5").Value

    With lo
        If .InsertRowRange Is Nothing Then
            Set r = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
        Else
            Set r = .InsertRowRange.Cells(1)
        End If
    End With

    r.Resize(, 5).Value = Application.Transpose(tbl)

End Sub

Bonjour à tous les deux,

Dans les deux cas ça fonctionne et c'est solide !

Merci beaucoup

Au plaisir

Germain

Rechercher des sujets similaires à "macro copie colle transpose tableau"