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 |
Partager