Option Base 1
Sub insere()
Application.ScreenUpdating = False
With Sheets("CS")
derlin = .Range("B" & .Rows.Count).End(xlUp).Row
tablo = .Range("A8:AN" & derlin)
Dim tablo1()
ReDim tablo1(40, 1)
ligne = 1
For n = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(n, 3) = "ssT" Then
tablo1(1, ligne) = ""
ligne = ligne + 1
ReDim Preserve tablo1(40, ligne)
End If
For m = 1 To 40
tablo1(m, ligne) = tablo(n, m)
Next m
ligne = ligne + 1
ReDim Preserve tablo1(40, ligne)
Next n
.Range("A8").Resize(UBound(tablo1, 2), UBound(tablo1, 1)) = Application.Transpose(tablo1)
For n = 8 To .Range("B65536").End(xlUp).Row
If .Range("B" & n) = "" Then .Range("D3:AN3").Copy Destination:=.Range("D" & n)
Next n
End With
Application.ScreenUpdating = True
End Sub
Sub insertion()
'debut = Timer
Application.ScreenUpdating = False
derlin = Range("B" & Sheets("CEGID").Rows.Count).End(xlUp).Row
Dim t2()
ReDim t2(1 To 1)
tablo = Range("A5:AP" & derlin)
For n = LBound(tablo, 1) To UBound(tablo, 1)
For m = LBound(tablo, 2) To UBound(tablo, 2)
x = x & tablo(n, m) & ";"
Next m
t2(UBound(t2)) = x
ReDim Preserve t2(1 To UBound(t2) + 1)
If InStr(x, "ssT") <> 0 Then
t2(UBound(t2)) = ";;;" & Split(t2(UBound(t2) - 1), ";")(1) & ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"
ReDim Preserve t2(1 To UBound(t2) + 1)
End If
x = ""
Next n
Dim t3()
ReDim t3(1 To UBound(t2), 1 To 41)
For n = LBound(t2) To UBound(t2)
For m = 1 To 41
If t2(n) <> "" Then t3(n, m) = Split(t2(n), ";")(m)
Next m
Next n
Range("A5").Resize(UBound(t3), 7) = t3
For n = 5 To Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
If Range("C" & n) <> "" Then Range("D3:AP3").Copy Destination:=Range("C" & n)
Next
'MsgBox (Timer - debut)
Application.ScreenUpdating = True
End Sub
