Microsoft 365 Dupliquer automatiquement lignes

Sub Duplique()
    Dim T0, F, Lig, L, N, Nb
    T0 = Timer
    Cells.ClearContents
    Application.ScreenUpdating = False
    Set F = Sheets("Feuil1")            ' A modifier suivant nom feuille BDD
    ActiveWorkbook.Save
    Lig = 2
    DL = F.Range("A65500").End(xlUp).Row
    Range("A1:Y1") = F.Range("A1:Y1").Value ' Copie des titres
    For L = 2 To DL
        Application.StatusBar = "Progression : " & L & " sur " & DL
        N = Application.CountIf(F.Range(F.Cells(L, "AA"), F.Cells(L, "CA")), ">0")
        Range("A" & Lig & ":Y" & Lig + N - 1) = F.Range("A" & L & ":Y" & L).Value ' Copier Coller valeurs
        For Nb = 1 To N ' Ajout des N°
            Cells(Lig + Nb - 1, "Z") = F.Cells(L, 26 + Nb)
        Next Nb
        Lig = Lig + N
    Next L
    Hmin
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
    MsgBox "Temps d'éxécution : " & Int(Timer - T0) & "s"
End Sub

Sub Dupliquer()
Dim t, der&, i&, j&, n&, k&, debut
   debut = Timer
   With Sheets("Feuil1")      'lecture données source dans tableau t
      If .FilterMode Then .ShowAllData
      der = .Cells(Rows.Count, "a").End(xlUp).Row
      t = .Range("a1:bx1").Resize(der)
   End With
   ReDim res(1 To 48 * UBound(t), 1 To 26)   'tableau résultat
   'recopie des en-têtes
   n = 1: For j = 1 To 26: res(n, j) = t(n, j): Next
   'duplications des autres lignes
   For i = 2 To UBound(t)
      For j = 27 To 74
         t(i, j) = Int(Val(Trim(t(i, j))))
         If t(i, j) > 0 Then
            n = n + 1: res(n, 26) = t(i, j)
            For k = 1 To 25: res(n, k) = t(i, k): Next
         End If
      Next j
   Next i
   'résultat sur feuille "Duplication"
   With Sheets("duplication")
      .Columns("a:z").ClearContents
      .Range("a1").Resize(n, UBound(res, 2)) = res
      .Select
   End With
   MsgBox "Résultat : " & Format(n - 1, "#,##0") & " lignes de données" & vbLf & vbLf & _
         "Durée d'exécution : " & Format(Timer - debut, "0.0\ sec.")
End Sub