Bonjour,
Pour vous expliquer simplement, j'ai un fichier global que je souhaiterai diviser en plusieurs onglets triés en fonction de la valeur de la première cellule des lignes.
Exemple:
Fichier effectif global avec affectation en colonne A
Je souhaiterai que mon fichier soit diviser en affectation, une affectation = un onglet.
J'ai trouvé une macro qui permettait de faire ce travail, mais elle ne prend pas en compte le format et la mise en forme de mes cellules.
Je débute en vba et je ne maitrise pas encore les collections bibliothèques.
Je remercie énormément tous ceux qui auront bien voulu m'aider.
Voici la macro (que je n'arrive pas à retravailler du tout):
'NOMMER LA FEUILLE D'ORIGINE "Données"
'LA LISTE COMMENCE EN A2
Sub Balaye()
Dim NoDupes As New Collection
'Application.ScreenUpdating = False
A = Range([A2], [A65536].End(xlUp)).Value
On Error Resume Next
' Boucle pour récupérer la collection d'items uniques
For J = 1 To UBound(A, 1)
NoDupes.Add A(J, 1), CStr(A(J, 1))
Next J
' Réactivation du gestionnaire d'erreurs
On Error GoTo 0
Range("A1").CurrentRegion.Select
With Selection.CurrentRegion
Intersect(.Cells, .Offset(1)).Select
End With
B = Selection.Value
NbCol = Selection.Columns.Count
[A1].Select
ReDim Tableau(1 To UBound(B), 1 To NbCol)
For k = 1 To UBound(B, 1)
For Z = 1 To NbCol
Tableau(k, Z) = B(k, Z)
Next Z
Next k
H = 1
For I = 1 To NoDupes.Count
Sheets.Add after:=Sheets(I)
ActiveSheet.Name = NoDupes(I)
For x = 1 To UBound(A, 1)
If Tableau(x, 1) = NoDupes(I) Then
For w = 1 To NbCol
Cells(H + 1, w).Value = Tableau(x, w)
Next w
H = H + 1
Else
End If
Next x
H = 1
Next I
Sheets("Données").Activate
NbSheet = ActiveWorkbook.Sheets.Count
Range([A1], [IV1].End(xlToLeft)).Select
Set MaPlage = Selection
[A1].Select
For NS = 2 To NbSheet
Set Destination = ActiveWorkbook.Sheets(NS).Range("A1")
MaPlage.Copy Destination
Next NS
'Application.ScreenUpdating = True
End Sub
Pour vous expliquer simplement, j'ai un fichier global que je souhaiterai diviser en plusieurs onglets triés en fonction de la valeur de la première cellule des lignes.
Exemple:
Fichier effectif global avec affectation en colonne A
Je souhaiterai que mon fichier soit diviser en affectation, une affectation = un onglet.
J'ai trouvé une macro qui permettait de faire ce travail, mais elle ne prend pas en compte le format et la mise en forme de mes cellules.
Je débute en vba et je ne maitrise pas encore les collections bibliothèques.
Je remercie énormément tous ceux qui auront bien voulu m'aider.
Voici la macro (que je n'arrive pas à retravailler du tout):
'NOMMER LA FEUILLE D'ORIGINE "Données"
'LA LISTE COMMENCE EN A2
Sub Balaye()
Dim NoDupes As New Collection
'Application.ScreenUpdating = False
A = Range([A2], [A65536].End(xlUp)).Value
On Error Resume Next
' Boucle pour récupérer la collection d'items uniques
For J = 1 To UBound(A, 1)
NoDupes.Add A(J, 1), CStr(A(J, 1))
Next J
' Réactivation du gestionnaire d'erreurs
On Error GoTo 0
Range("A1").CurrentRegion.Select
With Selection.CurrentRegion
Intersect(.Cells, .Offset(1)).Select
End With
B = Selection.Value
NbCol = Selection.Columns.Count
[A1].Select
ReDim Tableau(1 To UBound(B), 1 To NbCol)
For k = 1 To UBound(B, 1)
For Z = 1 To NbCol
Tableau(k, Z) = B(k, Z)
Next Z
Next k
H = 1
For I = 1 To NoDupes.Count
Sheets.Add after:=Sheets(I)
ActiveSheet.Name = NoDupes(I)
For x = 1 To UBound(A, 1)
If Tableau(x, 1) = NoDupes(I) Then
For w = 1 To NbCol
Cells(H + 1, w).Value = Tableau(x, w)
Next w
H = H + 1
Else
End If
Next x
H = 1
Next I
Sheets("Données").Activate
NbSheet = ActiveWorkbook.Sheets.Count
Range([A1], [IV1].End(xlToLeft)).Select
Set MaPlage = Selection
[A1].Select
For NS = 2 To NbSheet
Set Destination = ActiveWorkbook.Sheets(NS).Range("A1")
MaPlage.Copy Destination
Next NS
'Application.ScreenUpdating = True
End Sub