[XL-2010] transposition des données

Bonjour,

Essayez avec votre code modifié.
Les modifications sont signalées par des ///
Code:
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Base 1
 
' feuille source
 
Const FS = "Sheet1"
Const lidebFS = 1   '////
Const codebFS = 1
Const codur = "b"
 
' feuille but
 
Const FB = "Sheet2"
Const lidebFB = 2
Const codebfb = 1
 
Public Sub Transfert()
Dim lifinFS As Long, liFS As Long, k As Long, li1FS As Long, li2FS As Long
Dim liFB As Long
Dim tf, f, nuf
Dim maxdur As Double    '/// Double ou Variant
Dim plage As Range, C As Range, plagef As Range
 
' init tf
tf = Array("run", "cell", "oper", "pin", "back")
' en têtes feuille but
With Sheets(FB).Cells(lidebFB, codebfb)
  .Value = "dur"
 
End With
For k = 1 To 5
  With Sheets(FB).Cells(lidebFB, codebfb + k)
    .Value = tf(k)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
  End With
Next k
 
' transfert
With Sheets(FS)
  lifinFS = .Cells(Rows.Count, codebFS).End(xlUp).Row
 
  '///
  Set plage = .Range(codur & lidebFS + 1 & ":" & codur & lifinFS)
   maxdur = WorksheetFunction.Max(plage)
  '--- trouve le numéro de la première ligne contenant Max ---
  Dim R As Range
  Dim NbLig As Long
  For Each R In plage
    If R = maxdur Then
      NbLig = R.Row
      Exit For
    End If
  Next R
  '--- Resize la plage ---
  Set plage = plage.Resize(NbLig - 1, 1)
  '--- Copier/Coller de la plage ---
  ' colonne dur
  plage.Copy Sheets(FB).Cells(lidebFB + 1, 1)
    '///
 
 
 
  ' colonnes fact
  ' les 4 premières
 
  Set plage = .Range(.Cells(lidebFS, codebFS), .Cells(lifinFS, codebFS))
 
  li1FS = lidebFS + 1
  For nuf = 2 To 5
    f = tf(nuf)
    Set C = plage.Find(f, , , xlWhole)
    li2FS = C.Row
    Set plagef = .Range(.Cells(li1FS, codebFS + 2), .Cells(li2FS - 1, codebFS + 2))
 
    plagef.Copy Sheets(FB).Cells(lidebFB + 1, codebfb + nuf - 1)
    li1FS = li2FS
 
  Next nuf
 
  ' la cinquième
 
  li2FS = lifinFS
  .Range(Cells(li1FS, codebFS + 2), Cells(li2FS, codebFS + 2)).Copy Sheets(FB).Cells(lidebFB + 1, codebfb + 5)
End With
End Sub