Sub macro_lourdingue()
Dim i As Long
Dim j As Long
Dim z as String
Dim tab_la() As Variant
Application.ScreenUpdating = False
For i = 12 To 96 ' Step 33
If Not IsEmpty(Cells(i, 2)) Then
z = z & Cells(i, 2).Value & "+"
End If
Next i
Sheets("Document Unique").Range("X1") = _
UCase(Left(z, Len(z) - 1))
Range("X1").TextToColumns Range("X1"), xlDelimited, xlDoubleQuote, False, True, , , , True, "+"
With Range(Cells(1, 24), Cells(1, [IV1].End(xlToLeft).Column))
.Copy
Range("W2").PasteSpecial xlAll, xlNone, False, True
End With
Range("W1") = "AFILTRER"
Range("W1:W36").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"U1"), Unique:=True
Range("W1:IV36").ClearContents
tab_la = Application.Transpose(Range("U2:U21"))
For j = 1 To 20
Sheets.Add.Name = tab_la(j)
Next j
Range("U1:U21").ClearContents
Application.ScreenUpdating = True
End Sub