XL 2016 VBA macro concatener N fois 1000 lignes

Sub ConcatParN()
Const N = 1000
Dim t, derlig As Long, i As Long, i1 As Long, i2 As Long, k As Long, max As Long, s As String
   With Sheets("Test")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
      t = .Range("a1:a" & derlig)
      max = UBound(t) \ N
      If UBound(t) Mod N > 0 Then max = max + 1
      For k = 1 To max
         s = ""
         i1 = (k - 1) * N + 1
         i2 = i1 + N - 1: If i2 > UBound(t) Then i2 = UBound(t)
         For i = i1 To i2: s = s & ";" & t(i, 1): Next
         t(k, 1) = Mid(s, 2)
      Next k
      .Range("c1").CurrentRegion.Clear
      .Range("c1").Resize(max) = t
      Application.Goto .Range("a1"), True
   End With
End Sub

Option Explicit
 
Sub ConcatParN()
Dim t() As String, R As Range, I As Integer
ReDim t(0)
   With Sheets("Test")
    Set R = .Range(.Range("A1"), .Cells(.Cells.Rows.Count, "A").End(xlUp))
    For I = 1 To R.Rows.Count Step 1000
 
        t(UBound(t)) = Join(Application.Transpose(R.Range(R(I, 1).Address, R(I + 999,1).Address).Value), ";")
         ReDim Preserve t(UBound(t) + 1)
    Next
     ReDim Preserve t(UBound(t) - 1)
     While CBool(InStr(1, t(UBound(t)), ";;"))
      t(UBound(t)) = Replace(t(UBound(t)), ";;", "")
     Wend
      .Range("c1").CurrentRegion.Clear
      .Range("c1").Resize(UBound(t)+1) = Application.Transpose(t)

   End With
End Sub