Option Explicit
Sub Dupliquer_selon_valeur_v2()
Dim c As Range, o As Object
Application.ScreenUpdating = False
For Each c In Sheets("CAO").Columns(8).SpecialCells(xlCellTypeConstants, 23)
If c.Value = "T;" Then Sheets("TOP").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
If c.Value = "B;" Then Sheets("BOT").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
Next
For Each o In Sheets(Array("TOP", "BOT"))
If o.Application.WorksheetFunction.CountA(o.Rows("1:1")) = 0 Then o.Rows("1:1").Delete Shift:=xlUp
Next
Application.ScreenUpdating = True
End Sub