Bonjour,
Voici mon code :
Sub SuppHeureNuitSelectionPR()
Dim Dln&, i&, j%, sens, h, hd, hf, pk, pkd, pkf, aaX, xln(1 To 6), c As Range
hd = TimeSerial(0, 0, 0): hf = TimeSerial(24, 0, 0)
pkd = Array(0, 0.01, 1, 21, 22.4, 42, 45)
pkf = Array(0, 0.6, 3, 22.1, 24, 44, 48)
For j = 1 To 6
With ThisWorkbook.Worksheets("X" & j)
xln(j) = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
Next j
With ThisWorkbook.Worksheets("CollageBase")
Dln = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To Dln
'h = TimeValue(.Cells(i, 3).Value)
h = .Cells(i, 3)
sens= . cells(i, 11) ' c'est cette fonction qui est a modifier
If h > hd And h < hf Then
pk = Val(Replace(.Cells(i, 9).Value, ",", "."))
For j = 1 To 6
If pk > pkd(j) And pk < pkf(j) and sens = "PP1" Then 'Celle la est a modifier aussi
.Cells(i, 40) = "X" & j
.Cells(i, 3) = h: .Cells(i, 9) = pk
End If
Next j
End If
Next i
.Range("A1:AN" & Dln).Sort key1:=.Range("AN1"), order1:=xlAscending, _
Header:=xlYes
For j = 1 To 6
pk = "X" & j
Set c = .Columns("AN").Find(pk)
If Not c Is Nothing Then
h = c.Row: i = h
Do
i = i + 1
Loop While .Cells(i, 40) = pk
aaX = .Range("A" & h).Resize(i - h, 40).Value2
ThisWorkbook.Worksheets(pk).Range("A" & xln(j)) _
.Resize(UBound(aaX), 40).Value = aaX
End If
Next j
.Range("A1").CurrentRegion.ClearContents
End With
End Sub
Je souhaite faire de nouveau tri sur la colonne "k" (colonne 11) qui est composées de nom différent.
"PP1, Sens1, PP2, sens2 ou Hors tracé."
Est ce que quelqu'un peut m'aider?