1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
| Sub TransposerALaLigne()
Dim AireSource As Range
Dim CelluleSource As Range
Dim LigneDeTitreSource As Long
Dim DerniereColonneSource As Long
Dim DerniereLigneSource As Long
Dim LigneEnCoursCible As Long
Dim CtrJ As Long
Sheets("Cible").Cells.ClearContents
With Sheets("Source")
LigneDeTitreSource = 10 ' Adapter
DerniereColonneSource = .Cells(LigneDeTitreSource, .Columns.Count).End(xlToLeft).Column
DerniereLigneSource = .Cells(.Rows.Count, 1).End(xlUp).Row
Set AireSource = .Range(.Cells(LigneDeTitreSource + 1, 1), .Cells(DerniereLigneSource, 1))
End With
With Sheets("Cible")
.Range(.Cells(1, 1), .Cells(1, 3)) = Array("Date", "Heure", "Valeur")
.Cells.HorizontalAlignment = xlCenter
LigneEnCoursCible = 2
For Each CelluleSource In AireSource
For CtrJ = 1 To DerniereColonneSource - 1
With .Cells(LigneEnCoursCible, 1)
.Value = CelluleSource
.NumberFormat = "dd/mm/yyyy"
End With
With .Cells(LigneEnCoursCible, 2)
.Value = AireSource.Cells(1, 1).Offset(-1, CtrJ)
.NumberFormat = "h:mm;@"
End With
With .Cells(LigneEnCoursCible, 3)
.Value = CelluleSource.Offset(0, CtrJ)
.NumberFormat = "0"
.HorizontalAlignment = xlRight
End With
LigneEnCoursCible = LigneEnCoursCible + 1
Next CtrJ
Next CelluleSource
.Activate
End With
Set AireSource = Nothing
End Sub |
Partager