Sub VentilerBase()
Dim dico, tablo, Plage(1 To 3) As Range, i&, derLigPays&, RefData, RefPage, elem, aux
Application.ScreenUpdating = False: Application.DisplayAlerts = False
For Each elem In ThisWorkbook.Worksheets
If InStr(elem.Name, "-") > 0 Then elem.Delete
Next elem
With Sheets("Feuil1")
RefData = "@RefData": On Error Resume Next: Sheets(RefData).Delete: On Error GoTo 0
.Copy after:=Sheets(Sheets.Count): ActiveSheet.Name = RefData
RefPage = "@RefPage": On Error Resume Next: Sheets(RefPage).Delete: On Error GoTo 0
.Copy after:=Sheets(Sheets.Count): ActiveSheet.Name = RefPage
Sheets(RefPage).UsedRange.ClearContents
Sheets(RefPage).Shapes("btVentiler").Delete
End With
With Sheets(RefData)
Set Plage(1) = .Range("a1:k4")
derLigPays = .Cells(Rows.Count, "c").End(xlUp).Row
Set Plage(2) = .Range("a5:k" & derLigPays)
Plage(2).Sort key1:=.[b5], order1:=xlAscending, key2:=.[c5], order2:=xlAscending, Header:=xlNo
Set Plage(3) = .Range(.Cells(derLigPays + 1, "a"), .Cells(Rows.Count, 1).End(xlUp).Offset(, 10))
tablo = .Range(.Cells(1, "b"), .Cells(derLigPays, "c"))
Set dico = CreateObject("Scripting.Dictionary"): dico.CompareMode = vbTextCompare
For i = 5 To UBound(tablo)
elem = tablo(i, 1) & "-" & tablo(i, 2)
If Not dico.Exists(elem) Then dico(elem) = Array(i, i) Else dico(elem) = Array(dico(elem)(0), i)
Next i
End With
For Each elem In dico.Keys
Application.StatusBar = elem
Sheets(RefPage).Copy after:=Sheets(Sheets.Count): ActiveSheet.Name = elem
ActiveSheet.Cells.Delete
With Sheets(RefData)
Plage(1).Copy ActiveSheet.[a1]
.Range(.Cells(dico(elem)(0), "a"), .Cells(dico(elem)(1), "k")).Copy ActiveSheet.[a5]
Plage(3).Copy ActiveSheet.Range("a" & Rows.Count).End(xlUp)(2, 1)
End With
Next elem
dico.RemoveAll
For i = 5 To UBound(tablo)
elem = tablo(i, 2)
If Not dico.Exists(elem) Then
dico(elem) = tablo(i, 1)
Else
If InStr(dico(elem), tablo(i, 1)) = 0 Then dico(elem) = dico(elem) & "/" & tablo(i, 1)
End If
Next i
On Error Resume Next: Sheets("Anomalies").Delete: On Error GoTo 0
Sheets.Add after:=Sheets("Feuil1"): ActiveSheet.Name = "Anomalies"
Range("a1") = "Code pays": Range("b1") = "Continents": i = 1
For Each elem In dico.Keys
If InStr(dico(elem), "/") > 1 Then
i = i + 1: Cells(i, 1) = elem
aux = Split(dico(elem), "/")
Cells(i, 2).Resize(, UBound(aux) + 1) = aux
End If
Next elem
If i = 1 Then Sheets("Anomalies").Delete Else Sheets("Anomalies").Tab.Color = 192
On Error Resume Next: Sheets(RefData).Delete: On Error GoTo 0
On Error Resume Next: Sheets(RefPage).Delete: On Error GoTo 0
Application.StatusBar = False: Application.DisplayAlerts = True
Sheets("Feuil1").Activate: MsgBox "Ventilation Terminée"
End Sub