Transposition Excel

Question

Bonjour à tous,

vu que la recherche n'a rien donnée je me retourne vers vous.

je suis a la recherche d'une macro qui me permettrai de transposer mes données d'un tableau en ligne.Je m'explique

en colonne A j'ai mes Comptes 
en colonne B j'ai mes libellés de comptes
en colonne C, D, E, F,..... j'ai mes dates (01/01/2010 par exemple)
En croisement j'ai le montant.

je souhaite avoir

Compte /Lib/ Date/ Montant/

j'ai trouvé ça :
Sub MaTranspo()

Dim DerLig#, DerCol#
Dim i#, j#, k#
Dim mesdonnees

Application.DisplayAlerts False: Application.ScreenUpdating False

With ActiveSheet
DerLig = .[A65536].End(3).Row
DerCol = .[IV1].End(1).Column
ReDim mesdonnees(1 To (DerLig * DerCol), 1 To 3)
For i = 2 To DerLig
For j = 2 To DerCol
k = k + 1
mesdonnees(k, 1) = .Cells(i, 1)
mesdonnees(k, 2) = .Cells(1, j)
mesdonnees(k, 3) = .Cells(i, j)
Next j
Next i
End With
On Error Resume Next: Sheets("Résultat").Delete: On Error GoTo 0
Sheets.Add(after:=ActiveSheet).Name = "Résultat"

With Sheets("Résultat")
.[A1].Resize(UBound(mesdonnees, 1), UBound(mesdonnees, 2)) = mesdonnees
.Rows("1:1").Insert
.[A1] = "date": .[B1] = "Compte": .[c1] = "Montant"
End With

Application.DisplayAlerts True: Application.ScreenUpdating True

End Sub

mais ca ne prend pas en compte la colonne B

pouvez vous m'aider ??? merci

Renfield · Answer

j'ai du mal a visualiser le tableau de départ.

peut tu nous faire un schema ou une capture d'ecran ?

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

progscoubi · Answer

Bonjour,
en fait on vient de me dire que les libelles ne sont plus necessaires
il faudrait que la macro puisse aller chercher les valeurs dans toutes les feuilles.
   
voici un exemple de fichier

    A      |     B       |      C     | D     |
1   |      | 01/01/2010  |01/02/2010  | 
2   |608   |100          |200         |
3   |607   |200          |300 

le but est de l'avoir dans le sens suivant

     |   A   |   B       |    C   |
1    |607    |01/01/2010 |100     |
2    |607    |01/02/2010 |200     |

merci de ton aide

Renfield · Answer

rapidement, je dirai :
Sub test()
Dim oRgFrom As Range
Dim oRgTo As Range
Dim oRange As Range
    Set oRgFrom = Worksheets("Feuil1").Range("A1:C3")
    Set oRgTo = Worksheets("Feuil2").Range("A1")
    
    For Each oRange In oRgFrom.Cells
        If oRange.Column > oRgFrom.Column And oRange.Row > oRgFrom.Row Then
            oRgTo.Value = oRgFrom.Worksheet.Cells(oRange.Row, oRgFrom.Column).Value
            oRgTo.Offset(0, 1).Value = oRgFrom.Worksheet.Cells(oRgFrom.Row, oRange.Column).Value
            oRgTo.Offset(0, 2).Value = oRange.Value
            Set oRgTo = oRgTo.Offset(1)
        End If
    Next
End Sub



Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Transposition Excel

3 réponses

Votre réponse

Discussions similaires