Macro pour transposer des données

skamelot

XLDnaute Nouveau
Bonjour,

N'étant pas un pro dans l'écriture de macros, j'aurai besoin d'aide.

J'ai une feuille Excel avec des données disposées de la façon suivante :

Entreprise1 Nom1
Entreprise1 Nom2
Entreprise1 Nom3
Entreprise2 Nom1
Entreprise2 Nom2
Entreprise3 Nom1
Entreprise3 Nom2
Entreprise3 Nom3
Entreprise3 Nom4

J'aimerai un macro pour transposer les données en lignes afin d'obtenir un tableau de la sorte :

Entreprise1 Nom1 Nom2 Nom3
Entreprise2 Nom1 Nom2
Entreprise3 Nom1 Nom2 Nom3 Nom4


Auriez-vous des conseils, des idées ?
Merci par avance.
 

mth

XLDnaute Barbatruc
Re : Macro pour transposer des données

Bonsoir skamelot,

Tu peux essayer avec un petit code simple (à adapter à ton fichier):

Code:
    ...
    Range("A1:B10").Copy
    Range("D1").PasteSpecial Transpose:=True
    Application.CutCopyMode = False
   ...

Ceci dit à la main c'est facile aussi, en copiant ta zone, puis tu te places ailleurs et tu choisis "Collage spécial", tu coches la case "transposé".

Bien à toi,

mth
 

skamelot

XLDnaute Nouveau
Re : Macro pour transposer des données

Merci mth pour ton aide :) mais la transposition par collage spécial ne fontionne pas trop (ça me met tout sur 2 lignes)

J'aimerai que chaque entreprise soit sur une ligne avec les noms à côté.

De plus ma liste est trés longue et j'aimerai automatiser la transposition.

Et encore merci à toi
 

mth

XLDnaute Barbatruc
Re : Macro pour transposer des données

re :)

Effectivement, j'ai dû lire ta question trop vite :eek:

Une autre idée, testée chez moi avec un fichier simple, les noms des entreprises colone A, les noms des personnes colonne B, et la copie se faisant dans la même feuille à partir de la colonne D. J'imagine qu'il faudra adpater en fonction de ton vrai fichier ...
Code:
Dim i As Long, j As Long
Dim C As Range
Dim Ste As String, Nom As String

With Sheets("Feuil1")
        Nom = .Range("B1")
        Ste = .Range("A1")
        .Range("D1") = Ste
        .Range("E1") = Nom
    For i = 2 To .Range("A65530").End(xlUp).Row
            j = .Range("D65536").End(xlUp).Row
            If .Cells(i, 1) = Ste Then
                .Cells(j, 250).End(xlToLeft).Offset(0, 1) = .Cells(i, 2)
            Else
                j = .Range("D65536").End(xlUp).Offset(1, 0).Row
                .Cells(j, 4) = .Cells(i, 1)
                .Cells(j, 250).End(xlToLeft).Offset(0, 1) = .Cells(i, 2)
                Ste = .Cells(i, 1)
                Nom = .Cells(i, 2)
            End If
    Next i

End With

Bien à toi,

mth
 

Staple1600

XLDnaute Barbatruc
Re : Macro pour transposer des données

Bonjour à tous

Une version que j'ai retrouvé dans mes archives
(malheureusement je n'ai pas retrouvé le nom de l'auteur du code original)


Code:
Sub transpoer_avec_tableaux()
    Dim a, i As Long, b(), n As Long, maxCol As Long, w()
    a = Range("a1").CurrentRegion.Resize(, 2).Value
    ReDim b(1 To UBound(a, 1), 1 To Columns.Count)
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1: .add a(i, 1), Array(n, 1)
                b(n, 1) = a(i, 1)
            End If
            w = .Item(a(i, 1)): w(1) = w(1) + 1
            b(w(0), w(1)) = a(i, 2)
            .Item(a(i, 1)) = w
            maxCol = Application.Max(maxCol, w(1))
        Next
    End With
    Range("c1").Resize(n, maxCol).Value = b
End Sub
 

ridhaghanmi

XLDnaute Nouveau
Re : Macro pour transposer des données

Bonjour à tous,
comment on peut faire marcher cette marco en sens inverse.
Merci.

Sub transpoer_avec_tableaux()
Dim a, i As Long, b(), n As Long, maxCol As Long, w()
a = Range("a1").CurrentRegion.Resize(, 2).Value
ReDim b(1 To UBound(a, 1), 1 To Columns.Count)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
n = n + 1: .add a(i, 1), Array(n, 1)
b(n, 1) = a(i, 1)
End If
w = .Item(a(i, 1)): w(1) = w(1) + 1
b(w(0), w(1)) = a(i, 2)
.Item(a(i, 1)) = w
maxCol = Application.Max(maxCol, w(1))
Next
End With
Range("c1").Resize(n, maxCol).Value = b
End Sub
 

Discussions similaires