XL 2010 macro déconcatener ou défusion (résolu)

[chvalet]

Bonjour à tous

Le fichier joint comporte 3 feuilles
une feuille base
une feuille defusion
une feuille tcd

chaque ligne de la la feuille base correspond à un licencié qui pratique 1 ou X activités
je souhaiterais avec la feuille base créer une feuille defiusion qui me permettrait ensuite de créer des tableaux croises dynamiques.
On copie les données de base dans défusion en regardant la colonne S
Si la colonne S de la feuille base possède plusieurs données séparées par un "-".
je souhaiterais défusionner ces données et créer autant de lignes qu'il y a de données

exemple si j'ai 2 données dans colonne S (Badminton-Futsal),
je souhaiterais avoir 2 lignes , 1 avec badminton et une avec futsal pour le meme licencié dans la feuille defusion.

Auriez vous une idée ?

je vous remercie d avance
Chvalet

 

[Robert]

Bonjour Chvalet, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim OD As Worksheet 'déclare la variable OD (Onglet Defusion)
Dim OB As Worksheet 'déclare la variable OD (Onglet base)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim I As Long 'déclare la variable I (Incrément)
Dim NB As Integer 'déclare la variable NB (NomBre)
Dim J As Integer 'déclare la variable J (incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OB = Worksheets("base") 'définit l'onglet OD
Set OD = Worksheets("DEFUSION") 'définit l'onglet OD
OD.Range("A1").CurrentRegion.ClearContents 'efface d'éventuelles anciennes données
OB.Range("A1").CurrentRegion.Copy OD.Range("A1") 'copy les données de la base et les colle dans A1
DL = OD.Cells(Application.Rows.Count, "S").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne S de l'onglet OD
For I = DL To 2 Step -1 'boucle 1 : inversée dur toutes les lignes I de DL à 2
  If InStr(1, OD.Cells(I, "S"), "-", vbTextCompare) <> 0 Then 'si le symbole "-" est contenue dans la cellule de la boucle en colonne S
  NB = UBound(Split(OD.Cells(I, "S"), "-")) 'définit le nombre d'éléments séparés par ce symble (de 0 à NB)
  For J = NB To 1 Step -1 'boucle 2 : inversée sur le nombre d'éléments J de NB à 1
  OD.Rows(I).Copy 'copy la lige I
  OD.Rows(I + 1).Insert 'insère la ligne copiée une ligne en-dessous
  OD.Cells(I + 1, "S").Value = Split(OD.Cells(I, "S"), "-")(J) 'renvoie le Jième élément dans la cellule I+1 colonne S
  Next J 'prochain élément de la boucle 2
  OD.Cells(I, "S").Value = Split(OD.Cells(I, "S"), "-")(0) 'remplace la cellule I colonne S par le premier élément
  End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
Application.CutCopyMode = False 'supprime le clignotement lié au [copier/coller]
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

[Édition]
Je viens de me rendre compte que ça va poser problème pour Cross-Country qui va être sur deux lignes : Cross et Country... Mais je n'ai pas de solution sinon de l'écrire Cross Coutry.

 

[chvalet]

Bonjour Robert, le Forum

Grand Merci "Robert"
Tu as résolu ma demande.
Evidemment les activités ne doivent pas avoir de "-" dans leur écriture, seulement un " ".
Je modifie dans ma base.

je modifie le titre en résolu
bonne journée

Chvalet

 

[Si...]

Bonjour

Ou tu remplaces le – dans les noms composés par un espace comme le propose Robert ou tu remplaces les – de séparation par une virgule et là tu peux, dans la fenêtre de code de la feuille « DEFUSION » copier la macro qui se lance quand cet onglet est sélectionné :

Private Sub Worksheet_Activate()
    Dim R As Range, T, n As Byte, L As Long
    Application.ScreenUpdating = False
    [A2:Z6500].Clear: L = 1
    For Each R In [TBO[ACTIVITES]]  ‘plage de la feuille « base » dans un tableau
        T = Split(R, ";")
        For n = 0 To UBound(T)
            L = L + 1
            [TBO].Rows(R.Row - 1).Copy Cells(L, 1)
           Cells(L, 19) = T(n)
        Next
    Next
End Sub