Option Explicit
Sub essai()
supOnglets
Dim tab_L
Set tab_L = CreateObject("scripting.dictionary")
Dim tab_Datas
Set tab_Datas = CreateObject("scripting.dictionary")
Dim tab_Appareil
Set tab_Appareil = CreateObject("scripting.dictionary")
'----------------------------------------------------------------
' Lecture des données
'----------------------------------------------------------------
Dim Rang, Jalon, Appareil
Dim cpt, cle, l, cle1
Dim nom_onglet
With Sheets("Base1")
l = 6
While .Cells(l, 1) <> ""
Rang = .Cells(l, 2)
Jalon = .Cells(l, 4)
Appareil = LCase(Trim(.Cells(l, 1)))
'------------------------------------------- création nouvel onglet
If tab_Appareil.exists(Appareil) = False Then
nom_onglet = "S_curve" & Appareil
Sheets("modèle").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nom_onglet
Sheets(nom_onglet).Cells(5, 3) = Appareil
tab_Appareil(Appareil) = 1
End If
'------------------------------------------- indexation client pour numéro de ligne suivant appareil
cle1 = Appareil & "_" & CStr(Rang)
If tab_L.exists(cle1) = False Then
cpt = 0
For Each cle2 In tab_L
If Split(cle2, "_")(0) = Appareil Then cpt = cpt + 1
Next
tab_L(cle1) = cpt + 1
End If
'------------------------------------------- mémorisation des données
cle = Appareil & "_" & Rang & "_" & Jalon
tab_Datas(cle) = Array(.Cells(l, 5), .Cells(l, 6), .Cells(l, 7))
l = l + 1
Wend
End With
'----------------------------------------------------------------
' ecriture resultat
'----------------------------------------------------------------
For Each cle In tab_Datas
Appareil = Split(cle, "_")(0)
Rang = Split(cle, "_")(1)
Jalon = Split(cle, "_")(2)
cle1 = Appareil & "_" & CStr(Rang)
nom_onglet = "S_curve" & Appareil
l = tab_L(cle1) * 8 + 1
Select Case Jalon
Case "MAT"
Case "SO": l = l + 1
Case "FE": l = l + 2
Case "COC": l = l + 3
End Select
With Sheets(nom_onglet)
.Cells(l, 3) = Rang
.Cells(l, 4) = Jalon
.Cells(l, 5) = tab_Datas(cle)(0)
.Cells(l, 6) = tab_Datas(cle)(1)
.Cells(l, 7) = tab_Datas(cle)(2)
End With
Next
End Sub