Répartir d'un onglet vers plusieurs onglets selon critères

Bonjour à tous,

voici mon problème.

Je possède un ensemble de données dans l'onglet Feuil1 de mon fichier excel (voir fichier joint).

La colonne C de cet onglet comporte plusieurs valeurs à partir de la 12e ligne (des codes service à 4 chiffres).

Je souhaiterai via une macro, que toutes mes données de l'onglet Feuil1 soient copiées dans des onglets en fonction de la valeur du code service (chaque ligne de données se retrouverait donc dans l'onglet du service correspondant).

Merci d'avance pour votre aide.

Voici une ébauche de code adaptée pour mon cas, mais qui me renvoi une erreur au niveau du "With Sheets(Tablo(J))"

Sub Répartition()
Dim DLig As Long
Dim Mondico As Object
Dim Tablo
Dim J As Long
Dim Ws As Worksheet

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet

  ' Partie distribution des infos
  Set Mondico = CreateObject("Scripting.Dictionary")
  DLig = Range("A" & Rows.Count).End(xlUp).Row
  For J = 12 To DLig
    Mondico(Range("C" & J).Value) = Range("C" & J).Value
  Next J
  Tablo = Mondico.Items

  For J = 0 To UBound(Tablo)
    If FeuilleExiste(CStr(Tablo(J))) = False Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Tablo(J)
    End If
    With Sheets(Tablo(J))
      Ws.Range("A12:D" & DLig).AutoFilter field:=2, Criteria1:=Tablo(J)
      Ws.Range("A12:D" & DLig).SpecialCells(xlCellTypeVisible).Copy .Range("A2")
    End With
  Next J
  Ws.Select
  Ws.Range("A12:D" & DLig).AutoFilter
End Sub

Function FeuilleExiste(nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(nom).Name <> ""
  On Error GoTo 0
End Function

Salut,

Les données à reporter sont ajoutées aux données déjà en place dans les feuilles 2105 et 6360 ou elles les remplacent ?

Peux-tu avoir des références en colonne C autres que 2105 et 6360 ? Si oui, je présume qu’il faut créer - par la macro - les feuilles correspondantes manquantes ?

Tes données de la Feuil1 sont supprimées lorsqu’elles sont reportées ou elles restent en place ? Si elles ne sont pas supprimées, on en fait quoi la prochaine fois que la macro est lancée ?

A te relire.

Salut à tous les deux,

mais qui me renvoi une erreur au niveau du "With Sheets(Tablo(J))"

le code te renvoie une erreur car ta valeur Tablo(J) est un nombre.

Tu lui demandes la 2105e feuille de ton classeur et non la feuille nommée 2105.

tu as bien cerné le problème plus haut, dans ton code en déclarant Tablo(J) en tant que string... tu dois faire pareil ici

Voilà ton code corrigé (si j'ai bien compris ce que tu voulais faire)

Sub Répartition()
Dim DLig As Long
Dim Mondico As Object
Dim aa As String
Dim J As Long
Dim Tablo

Application.ScreenUpdating = False

  ' Partie distribution des infos
Set Mondico = CreateObject("Scripting.Dictionary")

With Sheets("Feuil1")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row

    For J = 12 To DLig
        Mondico(.Range("C" & J).Value) = .Range("C" & J).Value
    Next J

    Tablo = Mondico.Items
End With

  For J = 0 To Mondico.Count - 1
    If FeuilleExiste(CStr(Tablo(J))) = False Then
      Sheets("Feuil1").Copy after:=Sheets(Sheets.Count)
      aa = Tablo(J)
      ActiveSheet.Name = Tablo(J)
      Range("2:11").Delete

        With Sheets(aa)
            .Select
            .Rows("1:1").AutoFilter
            .Range("A2:D" & DLig).AutoFilter Field:=3, Criteria1:=aa 'Dlig correspond à la dernière ligne de la feuille 1
        End With
    End If

  Next J
Application.ScreenUpdating = True
End Sub

Function FeuilleExiste(nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(nom).Name <> ""
  On Error GoTo 0
End Function

Yvouille a écrit :

Salut,

Les données à reporter sont ajoutées aux données déjà en place dans les feuilles 2105 et 6360 ou elles les remplacent ?

C'était un exemple pour vous montrer le résultat de ce que doit faire la macro....à savoir répartir dans autant d'onglet que de code de service différent. Sauf qu'effectivement je projète d'avoir déjà créé les onglets "code service" avec des graphes pré-paramétrés etc. La macro ne fait que chercher les données et les répartir dans les onglets déjà créés et portant le nom de chaque service.

Yvouille a écrit :

Peux-tu avoir des références en colonne C autres que 2105 et 6360 ? Si oui, je présume qu’il faut créer - par la macro - les feuilles correspondantes manquantes ?

En l'occurrence non, ça pourrait renvoyer une erreur par exemple.

Yvouille a écrit :

Tes données de la Feuil1 sont supprimées lorsqu’elles sont reportées ou elles restent en place ? Si elles ne sont pas supprimées, on en fait quoi la prochaine fois que la macro est lancée ?

Je suis plutôt partant pour que les données restent...puisque cela me permettra de faire des graphes sur les données de l'ensemble.

Game Over a écrit :

Salut à tous les deux,

mais qui me renvoi une erreur au niveau du "With Sheets(Tablo(J))"

le code te renvoie une erreur car ta valeur Tablo(J) est un nombre.

Tu lui demandes la 2105e feuille de ton classeur et non la feuille nommée 2105.

tu as bien cerné le problème plus haut, dans ton code en déclarant Tablo(J) en tant que string... tu dois faire pareil ici

Merci beaucoup pour tes corrections. Malheureusement le résultat n'est pas exactement ce que je recherche. En effet ton code copie l'intégralité des données dans les onglets et effectue un filtre...or je souhaite qu'il y ait un réel dispatching pour qu'il n'y ait que des données liées à un seul code à chaque fois dans chaque onglet.

comme ça ?

Sub Répartition()
Dim DLig As Long, DCol As Integer
Dim Mondico As Object
Dim aa As String, bb As String
Dim J As Long
Dim Tablo

Application.ScreenUpdating = False

  ' Partie distribution des infos
Set Mondico = CreateObject("Scripting.Dictionary")

With Sheets("Feuil1")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    DCol = Cells(1, Columns.Count).End(xlToLeft).Column
    For J = 12 To DLig
        Mondico(.Range("C" & J).Value) = .Range("C" & J).Value
    Next J

    Tablo = Mondico.Items

    For J = 0 To Mondico.Count - 1
        aa = Tablo(J)
        If FeuilleExiste(CStr(Tablo(J))) = False Then
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = (aa)
            .Range(.Cells(1, 1), .Cells(1, DCol)).Copy Destination:=ActiveSheet.Range("A1")
        ElseIf FeuilleExiste(aa) = True And Not IsEmpty(Sheets(aa).Range("A2")) Then
            Sheets(aa).Range("A2:D" & DLig).ClearContents
        End If
    Next J

    For k = 12 To DLig
    bb = .Cells(k, 3)
    .Range(.Cells(k, 1), .Cells(k, DCol)).Copy Destination:=Sheets(bb).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Next k
End With

Application.ScreenUpdating = True
End Sub

    Function FeuilleExiste(nom As String) As Boolean
      On Error Resume Next
      FeuilleExiste = Sheets(nom).Name <> ""
      On Error GoTo 0
    End Function

ça a l'air de fonctionner parfaitement

je ferai différents tests dans les jours à venir et vous confirmerai ça.

Un grand merci à vous!

Après test, je m'aperçois que le code effectue le dispatching différemment qu'espéré.

Comme je l'ai précisé un peu plus haut dans un de mes posts, les différents onglets services sont déjà créés à l'avance dans mon fichier excel, et contiennent chacun des données pré-existantes dans la matrice A1:Dx (les en-têtes en ligne 1 et des formules en lignes 2 à 11 inclus).

Quand je lance ma macro, je souhaite que mes données (de la matrice A12:Dx de mon onglet général) soient dispatchées au même endroit dans les onglets service (dans la matrice A12:Dx).

Je ne sais pas si je suis bien clair. Sinon merci de me faire reformuler.

Merci d'avance. Bien à vous.

si j'ai bien compris, il te suffit de changer cette ligne

.Range(.Cells(1, 1), .Cells(1, DCol)).Copy Destination:=ActiveSheet.Range("A1")

par celle ci

.Range(.Cells(1, 1), .Cells(11, DCol)).Copy Destination:=ActiveSheet.Range("A1")

Malheureusement non cela ne fonctionne pas. Les données de la matrice A12:Dx de l'onglet général sont dispatchées directement en ligne 1 dans les onglets service, et non en ligne 12...ce qui écrase les données pré-existantes des matrices A1:D11 de mes onglets service.

comme ça, c'est un peu abstrait... remplace

.Range(.Cells(k, 1), .Cells(k, DCol)).Copy Destination:=Sheets(bb).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

par

.Range(.Cells(k, 1), .Cells(k, DCol)).Copy Destination:=Sheets(bb).Range("A12").End(xlUp).Offset(1, 0)

Si ce n'est pas ça, poste un exemple avec ce que tu obtiens et ce que tu souhaites obtenir

Ce n'est malheureusement pas ça.

Voici le fichier contenant l'onglet général "Feuil1"...en lançant la macro celle-ci créée deux onglets service 2105 et 6360 (que j'ai renommé par la suite 2105resultatmacro et 6360resultatmacro pour bien faire la différence avec ce que je recherche 2105recherché 6360recherché).

Je pense que c'est ça :

(à tester)

Merci infiniment, ça a l'air de fonctionner!