data transfer with regular interval

[Thespeedy20]

Hello forum,
I have data that needs to be transferred to a sheet, max 20 rows and skip 48 to copy the rest of the data (another 20 rows)...until all data is copied pictures

The data must be inserted between A22 and A41, then make the jump of 48 and copy again...repeat the operation as long as there is data

Sub Transfert()

  Dim CelSource As Range
  Dim CelCible As Range
  Dim Compteur As Integer
  Dim NBlignes As Integer
  Dim a As Integer
  Dim b As Integer
 
  Application.ScreenUpdating = False
  Application.EnableEvents = False
 
  Set CelSource = Worksheets("Trimestre_Formulaire").Range("A5")
  Set CelCible = Worksheets("Test").Range("A23")
 
  'NBlignes = Application.CountA(Sheets("Trimestre_Formulaire").Range("A:A")) - 1
  NBlignes = Worksheets("Trimestre_Formulaire").Range("A" & Rows.Count).End(xlUp).Row
  MsgBox NBlignes
    
   X = Application.RoundUp(NBlignes / 20, 0) * 48
    
    
     For i = 1 To X Step 48
        For Compteur = 1 To 20
        
        
    
    CelCible(a, 1).Value = CelSource(1, 1).Value
    CelCible(a, 2).Value = CelSource(1, 2).Value
    CelCible(a, 3).Value = CelSource(1, 3).Value
    CelCible(a, 4).Value = CelSource(1, 4).Value
    CelCible(a, 5).Value = CelSource(1, 5).Value
    CelCible(a, 6).Value = CelSource(1, 6).Value
    CelCible(a, 7).Value = CelSource(1, 7).Value
    
      
    Set CelSource = CelSource(2)
    Set CelCible = CelCible(2)
    
 
  
    Next
  
      Next
    
      
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

I have this code but it doesn't work...
Thank you for your help.

OLi