Collage transposé Excel

Bonjour tout le monde,

J'ai besoin de votre aide, je traite le pointage mensuel des centaines d'engins d'une entreprise comme indiqué sur la feuille 1 du fichier et je veux avoir comme résultat le tableau situé sur la feuille 2 sachant que j'ai essayé le collage transposé mais ça m'a pas donné le résultat souhaité, est ce qu'il y a d'autres moyens pour avoir le résultat souhaité.

Merci infiniment.

Bonjour,

Avec un tcd

Crdlmt

Bonjour DjiDji59430,

D'abord je vous remercie de votre aide, je veux exactement avoir comme le tableau de la feuille 2 " les dates en ligne ainsi que le code d'engins et le nom du chantier qui se répètent pour chaque ligne et le pointage de chaque date par ligne si l'engin est présent 1 s'il est absent 0 ".

Cordialement.

Salut Alex santana,

Salut Djidji,

en VBA.

Un double-clic en feuille '1' démarre la macro avec résultat en '2'.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract(), iIdx%
'
Cancel = True
'
tData = Range("A1").CurrentRegion.Value
For x = 2 To UBound(tData, 1)
    For y = 4 To UBound(tData, 2)
        iIdx = iIdx + 1
        ReDim Preserve tExtract(4, iIdx)
        For Z = 1 To 4
            tExtract(Z - 1, iIdx - 1) = tData(Choose(Z, 1, x, x, x), Choose(Z, y, 3, 2, y))
        Next
    Next
Next
With Worksheets("2")
    .Cells.Delete
    .Range("A1").Value = "Date"
    .Range("B1").Value = "Engin"
    .Range("C1").Value = "Chantier"
    .Range("D1").Value = "Statut"
    .Range("A2").Resize(iIdx, 4).Value = WorksheetFunction.Transpose(tExtract)
    .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
    .Columns("A:D").AutoFit
    .Activate
End With
'
End Sub

A+

Bonjour curulis57,

Je vous remercie de votre aide, c'est ce que je veux exactement sauf il y a un petit problème de la date.

Cordialement

Bonjour,

Le macro change le format de la date, est ce qu'il y a une possibilité de garder le format de la date.

Cordialement.

Salut Alex santana,

les formats de dates sont une casse-c...rie, made by Microsoft...

La solution ci-dessous est valable pour ce fichier-ci.

tExtract(0, iIdx - 1) = Format(tExtract(0, iIdx - 1), "[$-40c]mm/dd/yyyy")

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract(), iIdx%
'
Cancel = True
'
tData = Range("A1").CurrentRegion.Value
For x = 2 To UBound(tData, 1)
    For y = 4 To UBound(tData, 2)
        iIdx = iIdx + 1
        ReDim Preserve tExtract(4, iIdx)
        For Z = 1 To 4
            tExtract(Z - 1, iIdx - 1) = tData(Choose(Z, 1, x, x, x), Choose(Z, y, 3, 2, y))
        Next
        tExtract(0, iIdx - 1) = Format(tExtract(0, iIdx - 1), "[$-40c]mm/dd/yyyy")
    Next
Next
With Worksheets("2")
    .Cells.Delete
    .Range("A1").Value = "Date"
    .Range("B1").Value = "Engin"
    .Range("C1").Value = "Chantier"
    .Range("D1").Value = "Statut"
    .Range("A2").Resize(iIdx, 4).Value = WorksheetFunction.Transpose(tExtract)
    .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
    .Columns("A:D").AutoFit
    .Activate
End With
'
End Sub

A+

Bonjour curulis57 ,

Le problème est résolu, je vous remercie infiniment.

Cordialement.