Création catalogue

Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="£", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1)), TrailingMinusNumbers:=True

Cliquez pour agrandir...

1)), TrailingMinusNumbers:=True

Cliquez pour agrandir...

Cala Bruni - quelqu'un m'a dit sur une seule ligne car il n'y a qu'un titre

Celine Dion
j'attendrai "et sur la meme ligne" je ne vous oublie pas
je sais pas "et sur la meme ligne" pour que tu m'aimes encore
ETC...
l'idée c'est que si il n'y a qu'un titre on crée 1 ligne
s'il y en a plusieurs on met 2 titres par ligne et sans répéter le nom de l'artiste

Cliquez pour agrandir...

Sub Bouton1_Clic()
Application.ScreenUpdating = False
Range("A1:C" & Range("A65535").End(xlUp).Row).ClearContents
Range("G1:G" & Range("G65535").End(xlUp).Row).Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="£"
Columns("I:K").ClearContents
ligne = 1
For i = 1 To Range("G65535").End(xlUp).Row
Cells(ligne, 1) = Cells(i, 7)
Cells(ligne, 2) = Cells(i, 8)
If Cells(i + 1, 7) = Cells(i, 7) Then
Cells(ligne, 3) = Cells(i + 1, 8)
i = i + 1
End If
ligne = ligne + 1
Next i
Application.ScreenUpdating = True
End Sub

Cliquez pour agrandir...