Eclatement cellules avec condition

bonjour ;

qui peut m'aider avec un code vba ???

Merci!

Salut francbag,

un double-clic sur la feuille 'T' démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tSplit
'
Cancel = True
For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If InStr(Range("B" & x).Value, "DIS") > 0 Then
        tTab = Split(Range("B" & x).Value, Chr(10))
        For y = 0 To UBound(tTab)
            If InStr(tTab(y), "DIS") > 0 Then
                tSplit = Split(tTab(y), Chr(32))
                Range("H" & Range("H" & Rows.Count).End(xlUp).Row + 1).Resize(1, 4).Value = Array(tSplit(1), Format(Range("A" & x).Value, "hh:mm"), Replace(tSplit(3), ".", ","), tSplit(4))
            End If
        Next
    End If
Next
'
End Sub

A+

Bonjour

Bonjour à tous

Une autre version.

Bye !

Bonjour ,désolé pour le retard…

Curulis57 et gmb merci beaucoup pour votre professionnalisme.

je regarde et je vous tiens au courant.

merci

bonjour ;

Curulis57 un problème colonne H numéro+*, si possible pas * pour pouvoir travailler avec

Merci beaucoup

bonjour gmb;

merci pour la macro mais elle garde 2 numéro sur la même cellule.

Cordialement

Salut tout le monde,

voici la macro de curulis (merci à lui) avec le changement souhaité

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tSplit
'
Cancel = True
For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If InStr(Range("B" & x).Value, "DIS") > 0 Then
        tTab = Split(Range("B" & x).Value, Chr(10))
        For y = 0 To UBound(tTab)
            If InStr(tTab(y), "DIS") > 0 Then
                tSplit = Split(tTab(y), Chr(32))
                Range("H" & Range("H" & Rows.Count).End(xlUp).Row + 1).Resize(1, 4).Value = Array(Replace(tSplit(1), "*", ""), Format(Range("A" & x).Value, "hh:mm"), Replace(tSplit(3), ".", ","), tSplit(4))
            End If
        Next
    End If
Next
'
End Sub

merci!! m3ellem1

cordialement

Salut tout le monde,

Bien vu de l'équipe! Toujours plus forts à plusieurs!

A+

merci encore Curulis57!

cordialement