Option Explicit
Dim Appareil, LB, Rang1, Rang2
Dim tab_onglet
Dim New_rang, Old_rang, Cpt_Rang
Sub Essai2()
Application.ScreenUpdating = False
Set tab_onglet = CreateObject("scripting.dictionary")
Tri_Base
Dim LD ' ligne de départ d'une feuille S_curve
Dim CB ' ligne et colonne de la Base
'--------------------------------------------------------------
' récupération des onglets à créer
'--------------------------------------------------------------
LB = 6
With Feuil12
While .Cells(LB, 1) <> ""
Appareil = Trim(.Cells(LB, 1))
If tab_onglet.exists(Appareil) = False Then
tab_onglet(Appareil) = 9 'mémorise le numéro de la première ligne
Sheet_copy "modèle", "S_curve_" & Appareil, True
ActiveSheet.Cells(5, 3) = Appareil
Old_rang = ""
Cpt_Rang = -1
End If
ecrit_data
LB = LB + 1
Wend
End With
Cells(1, 1).Select
End Sub
'#############################################################
'#############################################################
Sub ecrit_data()
With Feuil12
New_rang = .Cells(LB, 2)
If New_rang = Old_rang Then
tab_onglet(Appareil) = tab_onglet(Appareil) + 1
Else
Old_rang = New_rang
Cpt_Rang = Cpt_Rang + 1
tab_onglet(Appareil) = 9 + (Cpt_Rang * 20)
End If
Sheets("S_curve_" & Appareil).Cells(tab_onglet(Appareil), 3) = .Cells(LB, 2) 'Rang
Sheets("S_curve_" & Appareil).Cells(tab_onglet(Appareil), 4) = .Cells(LB, 4) ' Jalons
Sheets("S_curve_" & Appareil).Cells(tab_onglet(Appareil), 5) = .Cells(LB, 5) 'mois
Sheets("S_curve_" & Appareil).Cells(tab_onglet(Appareil), 6) = .Cells(LB, 6) ' date r
Sheets("S_curve_" & Appareil).Cells(tab_onglet(Appareil), 7) = .Cells(LB, 7) ' date
End With
End Sub
'#############################################################
'#############################################################
Sub Tri_Base()
Feuil12.Select
Dim L1, C1, L2, C2, COL
L1 = 6
L2 = L1
C1 = 1
C2 = 7
While Cells(L2, 1) <> ""
L2 = L2 + 1
Wend
L2 = L2 - 1
Range(Cells(L1, C1), Cells(L2, C2)).Select
Feuil12.Sort.SortFields.Clear
COL = "A" & L1 & ":A" & L2 ' Appareil
Feuil12.Sort.SortFields.Add Key:=Range(COL), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
COL = "B" & L1 & ":B" & L2 ' Rang
Feuil12.Sort.SortFields.Add Key:=Range(COL), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
COL = "F" & L1 & ":F" & L2 ' Date r.
Feuil12.Sort.SortFields.Add Key:=Range(COL), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
COL = "D" & L1 & ":D" & L2 ' Jalons
Feuil12.Sort.SortFields.Add Key:=Range(COL), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Feuil12.Sort
.SetRange Range("A" & L1 & ":G" & L2)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells(1, 1).Select
End Sub