Bonjour à tous.

j'ai mis en place un macros pour éclater une cellule
Pour résumer. dans une feuille 1 j'ai un tableau avec des données.
Je voudrais en feuille 2 mettre certaines données, d'autre en feuille 3 et d'autre encore différentes en feuille 4.

j'ai mis en place le code suivant... mais il ne fonctionne que pour pour la feuille 2... (Aucun resultat sur 3 et 4)

Si quelqu'un voit une solution...

Merci d'avance

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub eclatement()
Dim Cel As Range
Dim X
i = 2
l = 2
 
For Each Cel In Range("G2:G19184")
    If Cel.Value <> "" Then
        X = Application.Transpose(Split(Cel, Chr(10)))
        Var = "A" & i
        Y = Range(Var).Value
        If i <> 2 Then
            l = l + UBound(X)
        End If
        i = i + 1
        Sheets("Feuil2").Range("B2:B2").Offset(l).Resize(UBound(X)) = X
        Sheets("Feuil2").Range("A2:A2").Offset(l).Resize(UBound(X)) = Y
    End If
Next Cel
 
For Each Cel In Range("H2:H19184")
    If Cel.Value <> "" Then
        X = Application.Transpose(Split(Cel, Chr(10)))
        Var = "A" & i
        Y = Range(Var).Value
        If i <> 2 Then
            l = l + UBound(X)
        End If
        i = i + 1
        Sheets("Feuil3").Range("B2:B2").Offset(l).Resize(UBound(X)) = X
        Sheets("Feuil3").Range("A2:A2").Offset(l).Resize(UBound(X)) = Y
    End If
Next Cel
 
For Each Cel In Range("I2:I19184")
    If Cel.Value <> "" Then
        X = Application.Transpose(Split(Cel, Chr(10)))
        Var = "A" & i
        Y = Range(Var).Value
        If i <> 2 Then
            l = l + UBound(X)
        End If
        i = i + 1
        Sheets("Feuil4").Range("B2:B2").Offset(l).Resize(UBound(X)) = X
        Sheets("Feuil4").Range("A2:A2").Offset(l).Resize(UBound(X)) = Y
    End If
Next Cel
 
End Sub