Option Explicit
Dim tablo, Tabapm(), Tabac(), Tabec(), Tabap(), Tabamo(), Tabcf(), Tabeci(), Tabpe(), Tabt(), Tabr(), Taberr(), i&, j&, kerr&, Kapm&, Kac&, Kec&, Kap&, Kamo&, Kcf&, Keci&, Kpe&, Kt&, Kr&
Sub Séparer()
Dim dlig As Integer
Dim mesfeuilles
Dim n As Integer
Dim mafeuille As Integer
mesfeuilles = Array("ATTENTE PRISE EN MAIN", "ATTENTE CONVOCATION", "EN COURS", "ATTENTE PIECES", "ATTENTE MO", "CONTROLE FINAL", "EN CIRCULATION", "PRESTATION EXTERNE", "TERMINE", "REFORME")
For n = LBound(mesfeuilles) To UBound(mesfeuilles)
mafeuille = Sheet(mesfeuilles(n))
With mafeuille
dlig = .Cells(Rows.Count, "B").End(xlUp).Row ' << ajout
If dlig = 1 Then dlig = 2 ' << ajout
tablo = .Range("B2:P" & dlig) ' << changement
Kec = 1
Kamo = 1
Kapm = 1
Kac = 1
Kap = 1
Kcf = 1
Keci = 1
Kpe = 1
Kt = 1
Kr = 1
kerr = 1
For i = 1 To UBound(tablo, 1)
If tablo(i, 8) = "EN COURS" Then
ReDim Preserve Tabec(1 To 17, 1 To Kec)
For j = 1 To 15
Tabec(j, Kec) = tablo(i, j)
Next j
Kec = Kec + 1
Else
If tablo(i, 8) = "ATTENTE MO" Then
ReDim Preserve Tabamo(1 To 17, 1 To Kamo)
For j = 1 To 15
Tabamo(j, Kamo) = tablo(i, j)
Next j
Kamo = Kamo + 1
Else
If tablo(i, 8) = "ATTENTE PRISE EN MAIN" Then
ReDim Preserve Tabapm(1 To 17, 1 To Kapm)
For j = 1 To 15
Tabapm(j, Kapm) = tablo(i, j)
Next j
Kapm = Kapm + 1
Else
If tablo(i, 8) = "ATTENTE CONVOCATION" Then
ReDim Preserve Tabac(1 To 17, 1 To Kac)
For j = 1 To 15
Tabac(j, Kac) = tablo(i, j)
Next j
Kac = Kac + 1
Else
If tablo(i, 8) = "ATTENTE PIECES" Then
ReDim Preserve Tabap(1 To 17, 1 To Kap)
For j = 1 To 15
Tabap(j, Kap) = tablo(i, j)
Next j
Kap = Kap + 1
Else
If tablo(i, 8) = "CONTROLE FINAL" Then
ReDim Preserve Tabcf(1 To 17, 1 To Kcf)
For j = 1 To 15
Tabcf(j, Kcf) = tablo(i, j)
Next j
Kcf = Kcf + 1
Else
If tablo(i, 8) = "EN CIRCULATION" Then
ReDim Preserve Tabeci(1 To 17, 1 To Keci)
For j = 1 To 15
Tabeci(j, Keci) = tablo(i, j)
Next j
Keci = Keci + 1
Else
If tablo(i, 8) = "PRESTATION EXTERNE" Then
ReDim Preserve Tabpe(1 To 17, 1 To Kpe)
For j = 1 To 15
Tabpe(j, Kpe) = tablo(i, j)
Next j
Kpe = Kpe + 1
Else
If tablo(i, 8) = "TERMINE" Then
ReDim Preserve Tabt(1 To 17, 1 To Kt)
For j = 1 To 15
Tabt(j, Kt) = tablo(i, j)
Next j
Kt = Kt + 1
Else
If tablo(i, 8) = "REFORME" Then
ReDim Preserve Tabr(1 To 17, 1 To Kr)
For j = 1 To 15
Tabr(j, Kr) = tablo(i, j)
Next j
Kr = Kr + 1
Else
ReDim Preserve Taberr(1 To 17, 1 To kerr)
For j = 1 To 15
Taberr(j, kerr) = tablo(i, j)
Next j
kerr = kerr + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next i
.Range("B2").Resize(UBound(tablo, 1), UBound(tablo, 2)).ClearContents
If Not estvide(Taberr) Then .Range("B2").Resize(UBound(Taberr, 2), 17) = Application.Transpose(Taberr)
End With
If Not estvide(Tabr) Then
dlig = Worksheets("REFORME").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("REFORME").Range("B" & dlig).Resize(UBound(Tabr, 2), 17) = Application.Transpose(Tabr)
End If
If Not estvide(Tabapm) Then
dlig = Worksheets("ATTENTE PRISE EN MAIN").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("ATTENTE PRISE EN MAIN").Range("B" & dlig).Resize(UBound(Tabapm, 2), 17) = Application.Transpose(Tabapm)
End If
If Not estvide(Tabac) Then
dlig = Worksheets("ATTENTE CONVOCATION").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("ATTENTE CONVOCATION").Range("B" & dlig).Resize(UBound(Tabac, 2), 17) = Application.Transpose(Tabac)
End If
If Not estvide(Tabec) Then
dlig = Worksheets("EN COURS").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("EN COURS").Range("B" & dlig).Resize(UBound(Tabec, 2), 17) = Application.Transpose(Tabec)
End If
If Not estvide(Tabap) Then
dlig = Worksheets("ATTENTE PIECES").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("ATTENTE PIECES").Range("B" & dlig).Resize(UBound(Tabap, 2), 17) = Application.Transpose(Tabap)
End If
If Not estvide(Tabamo) Then
dlig = Worksheets("ATTENTE MO").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("ATTENTE MO").Range("B" & dlig).Resize(UBound(Tabamo, 2), 17) = Application.Transpose(Tabamo)
End If
If Not estvide(Tabcf) Then
dlig = Worksheets("CONTROLE FINAL").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("CONTROLE FINAL").Range("B" & dlig).Resize(UBound(Tabcf, 2), 17) = Application.Transpose(Tabcf)
End If
If Not estvide(Tabeci) Then
dlig = Worksheets("EN CIRCULATION").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("EN CIRCULATION").Range("B" & dlig).Resize(UBound(Tabeci, 2), 17) = Application.Transpose(Tabeci)
End If
If Not estvide(Tabpe) Then
dlig = Worksheets("PRESTATION EXTERNE").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("PRESTATION EXTERNE").Range("B" & dlig).Resize(UBound(Tabpe, 2), 17) = Application.Transpose(Tabpe)
End If
If Not estvide(Tabt) Then
dlig = Worksheets("TERMINE").Cells(Rows.Count, "B").End(xlUp).Row + 1
Worksheets("TERMINE").Range("B" & dlig).Resize(UBound(Tabt, 2), 17) = Application.Transpose(Tabt)
End If
' End If
Erase Taberr
Erase Tabapm
Erase Tabamo
Erase Tabac
Erase Tabec
Erase Tabap
Erase Tabcf
Erase Tabeci
Erase Tabpe
Erase Tabt
Erase Tabr
dlig = Ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
With Ws.Range("I2:I" & dlig).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=ETAT"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Ws.Range("J2:J" & dlig).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=PRESTATION"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Ws.Range("L2:L" & dlig).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=EXTERNE"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Ws.Range("N2:N" & dlig).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=NOMS"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Ws.Range("M2:M" & dlig).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=NOMS"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Ws.Range("P2:P" & dlig).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=OUI"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Ws.Range("Q2:Q" & dlig).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=OUI"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Next n
MsgBox "Mise à jour terminée."
End Sub
Function estvide(anArray As Variant) As Boolean
Dim i As Integer
On Error Resume Next
i = UBound(anArray, 1)
If Err.Number = 0 Then
estvide = False
Else
estvide = True
End If
End Function
