Macro avec transposition

DelphineM

XLDnaute Nouveau
Bonsoir,
Je cherche à créer une macro pour transposer des données tout en gardant la référence.
J'ai mis un exemple simple en PJ avec mon onglet d'origine et l'onglet cible. En réalité j'ai quelques dizaines de colonnes à transposer de cette façon dans différents onglets.
Je ne connais pas trop les macros, j'ai réussi à en comprendre et adapter quelques-unes trouvées sur ce forum. Aussi, je ne serai pas contre quelques explications complémentaires pour que je comprenne bien la solution que vous voudrez bien m'apporter.

Merci de votre aide
 

Pièces jointes

  • Exemple pb excel.xlsx
    11.5 KB · Affichages: 13

Staple1600

XLDnaute Barbatruc
Bonsoir


Tu as de la chance
Cette macro que j'ai posté cette semaine dans un autre fil fait pile poil ce que tu veux ;)
VB:
Sub Macro2_générique()
Dim sht As Worksheet, pvt As PivotTable, pvtCache As PivotCache, sTableau$, NomTCD$
X = Int(Rnd * 100000) + Second(Time)
NomTCD = InputBox("Nom du TCD?", "Test", "_TCD_" & X)
'Attention: il faut sélectionner le tableau initial
sTableau = Selection.Parent.Name & "!" & Selection.Address(ReferenceStyle:=xlR1C1)
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlConsolidation, SourceData:=sTableau)
Set pvt = pvtCache.CreatePivotTable(TableDestination:="", TableName:=NomTCD)
    pvt.DataPivotField.PivotItems("Nombre de Valeur").Position = 1
    pvt.PivotFields("Colonne").Orientation = xlHidden
    pvt.PivotFields("Ligne").Orientation = xlHidden
Range("A2").Select
Selection.ShowDetail = True
End Sub
NB: Bien faire ce qu'on lit en vert dans la macro avant de la lancer.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Delphine, Staple,
Un autre exemple en PJ et en moins "inspiré" avec:
VB:
Sub Transpose()
Dim DerLig%, indexW%, Sh, i%, j%
Application.ScreenUpdating = False                          ' Figeage écran pour aller plus vite
Sheets("Cible").Range("A2:C1000").ClearContents             ' Effacement matrice Cible
DerLig = Sheets("Origine").Range("A65500").End(xlUp).Row    ' Recherche Dernière Ligne d'Origine
indexW = 2                                                  ' IndexW : Index d'écriture dans page Cible
Set Sh = Sheets("Cible")                                    ' Affectation Sh
With Sheets("Origine")
    For i = 2 To DerLig                                     ' Pour toute les lignes de Origine
        For j = 0 To 2                                      ' Mettre sur trois lignes
            Sh.Cells(indexW + j, "A") = .Cells(i, "A")      ' L' ID
            Sh.Cells(indexW + j, "C") = .Cells(i, j + 2)    ' Origine,Processus,LP
        Next j
        Sh.Cells(indexW + 0, "B") = .Cells(1, "B")          ' Recopier les valeurs de Origine,Processus,LP sur colonne D
        Sh.Cells(indexW + 1, "B") = .Cells(1, "C")
        Sh.Cells(indexW + 2, "B") = .Cells(1, "D")
        indexW = indexW + 3                                 ' Mise à jour index écriture pour prochaine ligne Origine
    Next i
End With
End Sub
 

Pièces jointes

  • Exemple pb excel.xlsm
    19.7 KB · Affichages: 10

DelphineM

XLDnaute Nouveau
Bonjour, tout d'abord merci de vos réponses (très rapides en + !)
@Staple : je ne comprends pas grand chose à ta macro, donc c'est compliqué à réutiliser. Je ne veux pas utiliser la façon manuelle car c'est pour de la reprise de données et je vais devoir avoir 3-4 fois la même macro dans mon fichier pour aller chercher des colonnes différentes et je réutiliserais une 20aine de fois le fichier.

@sylvanu : j'ai bien compris la macro, merci pour les commentaires, ça aide et j'ai réussi à l'adapter. Par contre, au-delà de 9 colonnes dans Origine, ça bugue "Erreur d'exécution "6" : dépassement de capacité" et ça pointe la ligne
Sh.Cells(indexW + j, "A") = .Cells(i, "A") ' L' ID en colonne A

Une idée STP ?
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, DelphineM, sylvanu, Roblochon

DelphineM
Je ne suis pas sur que tu ais pris le temps de tester ma macro.
DelphineTranspo.jpg

Car je ne vois pas où est la complication...
 

Staple1600

XLDnaute Barbatruc
Re

Une version allégée (à tester sur le fichier exemple du message#1)
NB: Avant de faire le test, effacer le contenu de la feuille Cible.
VB:
Sub traitement()
Application.ScreenUpdating = False
transposer
nettoyer
Sheets("Cible").Activate
End Sub
Private Sub transposer()
Dim f As Worksheet, pvt As PivotTable, pvtCache As PivotCache, sTab$
Set f = Sheets("Cible"): sTab = Selection.Parent.Name & "!" & Selection.Address(ReferenceStyle:=xlR1C1)
    Set pvt = ActiveWorkbook.PivotCaches.Create(SourceType:=3, SourceData:=sTab).CreatePivotTable("", "")
    pvt.DataPivotField.PivotItems("Nombre de Valeur").Position = 1
    pvt.PivotFields("Colonne").Orientation = 0: pvt.PivotFields("Ligne").Orientation = 0
Range("A2").Select: Selection.ShowDetail = True: ActiveSheet.ListObjects(1).Unlist
ActiveSheet.[A1].CurrentRegion.Cut f.[A1]: f.[A1:C1] = Array("ID", "Référentiel", "Valeurs  Cibles")
f.[B1:C1].Columns.AutoFit: f.[A2].Columns.AutoFit
End Sub
Private Sub nettoyer()
Dim f As Worksheet, Noms_F$
Noms_F = "Origine,Cible"
Application.DisplayAlerts = False
    For Each f In Worksheets
        If InStr(Noms_F, f.Name) = 0 Then
        f.Delete
    End If
Next
End Sub
 

DelphineM

XLDnaute Nouveau
Bonsoir Staple, non , je n'ai pas testé ta macro car je ne l'ai pas comprise et je suis donc incapable de l'adapter. J'ai joint un fichier simple comme exemple mais j'ai beaucoup de cas possibles.
Les explications de Sylvanu contenues dans la macro m'ont beaucoup aidé et je les ai même complétées avec mes mots
For i = 2 To DerLig ' Pour toutes les lignes de F
For j = 0 To 8 ' Mettre sur X lignes :
Sh.Cells(indexW + j, "A") = .Cells(i, "A") ' L' ID en colonne A
Sh.Cells(indexW + j, "F") = .Cells(i, j + 2) ' Valeur de la colonne concernée à mettre en colonne F.
Next j
For j = 1 To 9 ' Nb de colonnes concernées, yc avec colonne ID
Sh.Cells(indexW + j - 1, "G") = .Cells(1, j + 1) ' Recopier les intitulés de colonnes en colonne G.


Cette macro doit me servir pour de la reprise de donnée et je subis le format dans lequel je dois mettre l'ordre des colonnes.
En tous cas, merci à tous de vos contributions !
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 889
Membres
101 831
dernier inscrit
gillec