éclatement de données grâce à macro commande

[david.ridelaire]

Bonjour à tous

je suis à la recherche d'une macro qui me permettrait d'éclater des données compilées sur une seule feuille excel issue d'une génération AS400.

en plusieurs feuilles avec des clefs de répartitions précises, l'exemple est dans la pièce que j'ai jointe.

d'avance je remercie la communauté de l’intérêt portait à la chose.

david

 

[Compte Supprimé 979]

Re : éclatement de données grâce à macro commande

Bonjour David

Voici le code à intégrer

Sub Répartition()
  Dim DLig As Long, Lig As Long, NLig As Long
  Dim ShtS As Worksheet, ShtD As Worksheet
  ' Définir la feuille source
  Set ShtS = Sheets("Feuil1")
  ' Déterminer le numéro de la dernière ligne
  DLig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ' Pour chaque ligne
  For Lig = 2 To DLig
    ' Définir la feuille de destination
    On Error Resume Next
    Set ShtD = Sheets(ShtS.Range("R" & Lig).Value)
    If Err.Number <> 0 Then
      Err.Clear ' Effacer l'erreur
      ' La feuille n'existe pas, il faut donc la créer
      Sheets.Add After:=Sheets(Sheets.Count)
      ' Avec la feuille créée
      With ActiveSheet
        ' Lui donner le nom
        .Name = ShtS.Range("R" & Lig)
        ' Remplir la ligne d'entête
        .Range("A1") = ShtS.Range("H1")
        .Range("B1") = ShtS.Range("C1")
        .Range("C1") = ShtS.Range("AD1")
        .Range("E1") = ShtS.Range("J1")
        .Range("F1") = ShtS.Range("A1")
      End With
      ' Définir la feuille de destination
      Set ShtD = ActiveSheet
    End If
    On Error GoTo 0
    ' Déterminer la nouvelle ligne à écrire
    NLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 1
    ' Inscrire les différentes valeurs
    ShtD.Range("A" & NLig) = ShtS.Range("H" & Lig)
    ShtD.Range("B" & NLig) = ShtS.Range("C" & Lig)
    ShtD.Range("C" & NLig) = ShtS.Range("AD" & Lig)
    ShtD.Range("E" & NLig) = ShtS.Range("J" & Lig)
    ShtD.Range("F" & NLig) = ShtS.Range("A" & Lig)
  Next Lig
End Sub

A+