Sub autre()
Application.ScreenUpdating = False
With Sheets("Feuil1")
tabloTitres = Array("DateTime Started:", "Dose Area Product:", "Dose (RP):", "Positioner Primary Angle:", "Positioner Secondary Angle:", "Collimated Field Area:", "KVP:", "X-Ray Tube Current:", "Exposure Time:", "Distance Source to Detector:", "Distance Source to Isocenter:", "Table Height Position:")
derLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Set irrad = .[A:A].Find(what:="Irradiation Event X-Ray Data", LookIn:=xlValues, lookat:=xlWhole)
If Not irrad Is Nothing Then premAdr = irrad.Address
Do
If irrad.Offset(4, 0) Like "*Fluoroscopy*" Then
Set f = Sheets("Fluoro")
Else
Set f = Sheets("Graphie")
End If
nouvLigne = f.Cells(.Rows.Count, 1).End(xlUp).Row + 1
For titre = 0 To UBound(tabloTitres)
toto = Application.Match(tabloTitres(titre), .Cells(irrad.Row, 1).Resize(derLigne - irrad.Row, 1), 0) + irrad.Row
If titre = 0 Then
valeurDate = CDate(.Cells(toto, 1))
Else
valeurAutre = Replace(Split(.Cells(toto, 1), " ")(0), ".", ",")
End If
f.Cells(nouvLigne, titre + 1) = IIf(titre = 0, valeurDate, CDbl(valeurAutre))
Next titre
Set irrad = .[A:A].FindNext(irrad)
Loop While Not irrad Is Nothing And irrad.Address <> premAdr
End With
Application.ScreenUpdating = True
End Sub