Option Explicit
Sub ventilation_Suivant_Modele()
Dim i As Long, n As Integer, lr As Integer
Dim TbE(), TbS(), d As Object, Société As Variant, Modele As Range
Set Modele = Sheets("model").Range("A1:L6")
Set d = CreateObject("scripting.dictionary")
With Worksheets("GL") 'avec la feuille "GL"
TbE = .Range("A1").CurrentRegion.Value ' on met toutes les données dans une variable tableau (plus rapide)
'Boucle pour récupérer Sociétés sans doublons dans le dictionnaire 'd'
For i = 2 To UBound(TbE)
d(TbE(i, 1)) = ""
Next i
Application.ScreenUpdating = False: Application.DisplayAlerts = False 'on fige l'écran et desactive les alertes
For Each Société In d.keys 'boucle sur chaque société
n = 0 'remise à zero du compteur n
For i = 2 To UBound(TbE) 'boucle pour récupérer données par société
If TbE(i, 1) = Société Then
n = n + 1
ReDim Preserve TbS(1 To 11, 1 To n)
TbS(1, n) = TbE(i, 1)
TbS(2, n) = TbE(i, 2)
TbS(3, n) = TbE(i, 3)
TbS(4, n) = TbE(i, 4)
TbS(5, n) = TbE(i, 5)
TbS(6, n) = TbE(i, 6)
TbS(7, n) = TbE(i, 7)
TbS(8, n) = TbE(i, 8)
TbS(9, n) = TbE(i, 10)
TbS(10, n) = TbE(i, 11)
TbS(11, n) = TbE(i, 12)
End If
Next i
On Error Resume Next
Sheets(Société).Delete 'suppresion de la feuille
On Error GoTo 0
Sheets.Add(after:=Sheets(Sheets.Count)).Name = Société 'ajout d'une feuille+nommage
With Sheets(Société)
Modele.Copy .Range("A1") 'copie de l'entete du modele
lr = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 'derniere ligne de la feuille
.Range("B" & lr).Resize(UBound(TbS, 2), UBound(TbS)) = Application.Transpose(TbS) 'restitution données sur chaque feuille
.Range("B" & lr).Resize(UBound(TbS, 2), UBound(TbS)).Borders.LineStyle = 1 'cadrillage
' .Range("B" & lr).Resize(, UBound(TbS)).EntireColumn.AutoFit ' ajustement largeur colonnes
End With
Next Société
.Activate
End With
MsgBox "Traitement terminé!", vbOKOnly + vbInformation, "SUCCES"
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub
