' Module1 standard code a copier
Sub Repart()
Dim F1 As Worksheet
Set F1 = Worksheets("Feuil1")
Dim TabRepart() As Variant
TabRepart = F1.Range(F1.Cells(1, 1), F1.Cells(F1.Cells(65536, 1).End(xlUp).Row, 23))
ReDim Preserve TabRepart(LBound(TabRepart, 1) To UBound(TabRepart, 1), LBound(TabRepart, 2) To 25)
Dim MonObjet As Methode
Set MonObjet = New Methode
' Reperage des doublons
MonObjet.doublon = TabRepart
' Compteur = Nombres de feuilles par code
MonObjet.Cpt
' Creation de tableau pour stocké les valeurs
MonObjet.CreationFeuil
' coller les valeurs dans les feuilles correspondantes
MonObjet.TransfertVal
End Sub
' ici le module de classe avec nom Methode
Private mTabRepart() As Variant
Private mCpt As Integer
Property Let doublon(TabRepart() As Variant)
mTabRepart = TabRepart
' reperage des doublons
For i = LBound(mTabRepart, 1) To UBound(mTabRepart, 1)
mTabRepart(i, 24) = mTabRepart(i, 2)
For j = i + 1 To UBound(mTabRepart, 1)
If mTabRepart(i, 2) = mTabRepart(j, 2) Then
mTabRepart(i, 24) = ""
End If
Next j
Next i
End Property
Sub Cpt()
For i = LBound(mTabRepart, 1) To UBound(mTabRepart, 1)
If mTabRepart(i, 24) <> Empty Then
mCpt = mCpt + 1
End If
Next i
End Sub
Sub CreationFeuil()
For i = 2 To UBound(mTabRepart, 1)
If mTabRepart(i, 24) <> Empty Then
Set Ftemp = Sheets.Add(After:=Sheets(Sheets.Count))
Ftemp.Name = CStr(mTabRepart(i, 24))
For j = LBound(mTabRepart, 2) To UBound(mTabRepart, 2) - 2
Sheets(CStr(mTabRepart(i, 2))).Cells(1, j) = mTabRepart(1, j)
Next j
End If
Next i
End Sub
Sub TransfertVal()
Dim F As Worksheet
For i = 2 To UBound(mTabRepart, 1)
For j = LBound(mTabRepart, 2) To UBound(mTabRepart, 2) - 2
Set NonFeuil = Sheets(CStr(mTabRepart(i, 2)))
NonFeuil.Cells(NonFeuil.Cells(65536, j).End(xlUp).Row + 1, j) = mTabRepart(i, j)
Set NonFeuil = Nothing
Next j
Next i
End Sub