XL 2013 Recherche selon critère et transposer des données avec récurrence

Sub ROK()

        Dim feuille As Worksheet
        Dim formules_modèles As Range
        Dim nom As String
        Dim Fichiertxt As Variant

   Sheets.Add after:=Sheets(Sheets.Count)
    Set feuille = ActiveSheet

        Fichiertxt = Application.GetOpenFilename("Text Files (*.txt), *.txt")
        If Fichiertxt <> False Then
            With feuille.QueryTables.Add(Connection:="TEXT;" & Fichiertxt, Destination:=Range("$A$5"))
                .Name = nom
                .FieldNames = True
                .PreserveFormatting = True
                .SaveData = True
                .AdjustColumnWidth = True
                .TextFileStartRow = 2
                .TextFileParseType = xlDelimited
                .TextFileSemicolonDelimiter = True
                .Refresh BackgroundQuery:=False
            End With
        End If
 
  
  
     Dim xRow As Long    ' 1 to 10000
    Dim xCol As Long    ' 1 to 5 (de G à D)
    Dim dRow As Long    ' Destination
    Dim x As Integer
    Dim FinalCount As Integer
    Debug.Print Now
    
    dRow = 4
    FinalCount = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))
    Range("$A:$A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    Dim Plage As Range
    Dim CL As Integer
    Dim LM As String
    LM = "=="
    CL = 1
    Set Plage = Cells(2, 1).Resize(UsedRange.Rows.Count - 1, UsedRange.Columns.Count)
     With Range("A1")
            .AutoFilter
            .AutoFilter CL, LM
            On Error Resume Next
            
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
      
            .AutoFilter
    End With
    
    x = 20
    For A = 1 To FinalCount Step x
    For xRow = 1 To x Step 1
        For xCol = 2 To x
        Cells(dRow, xCol) = Cells(xRow, 1)
        dRow = dRow + 1
        Next xCol
    Next xRow
    Next A
    Debug.Print Now
    
    
End Sub