Extraction de données d'un tableau

Sub Tri()
 Dim Ws1 As Worksheet, Ws2 As Worksheet
 Dim DerL As Long,  Ind As Long, MonTab, TabFin()
 Dim Rep As Byte, Rep1 As Byte

 Set Ws1 = Worksheets("Feuil2")
 Set Ws2 = Worksheets("récup")

 DerL = Ws1.Range("A" & Rows.Count).End(xlUp).Row
 MonTab = Ws1.Range("A2:D" & DerL)

 Rep = 0
 Ind = 1
 While Ind < UBound(MonTab, 1)
    If MonTab(Ind, 4) = Rep Then
        x = x + 1
        For i = 1 To 3
            ReDim Preserve TabFin(1 To 3, 1 To x)
            TabFin(i, x) = MonTab(Ind + Rep1 - 1, i)
        Next i
        If Rep1 = 1 Then Rep1 = Rep Else Rep1 = Rep1 - 1
    
        Ind = Ind + Rep
    Else
        Rep = MonTab(Ind, 4)
        Rep1 = Rep
    End If
 Wend

 Ws2.Range("A2").Resize(UBound(TabFin, 2), UBound(TabFin, 1)) = Application.Transpose(TabFin)
End Sub

Ws1.Range("D2:D" & DerL).Formula = "=COUNTIF($A$2:$A$" & DerL & ",A2)"

DerL = Ws1.Range("A" & Rows.Count).End(xlUp).Row

 MonTab = Ws1.Range("A2:D" & DerL)

Sub infoimage()
 Dim bm_départ As BITMAP
 Dim x1&, y1&, m&, l&, n&, p&, i&, hDC&
 Dim Tablo(), tabfin()
 Dim Rep As Byte, Rep1 As Byte
 Dim MonDico

 Set MonDico = CreateObject("Scripting.Dictionary")
 fich_img = Application.GetOpenFilename(, , "choisissez l'image à récupérer (.bmp)")
 If fich_img = False Then Exit Sub


 'récupérer l'image
 écran_DC = GetDC(0)
 Set img_départ = LoadPicture(fich_img)
 GetObjectAPI img_départ.Handle, Len(bm_départ), bm_départ 'récupère le bitmap correspondant à l'image
 'créer un bitmap img_ini, dans le imgDC pour y accueillir l'image
 img_DC = CreateCompatibleDC(écran_DC)
 img_DCOld = SelectObject(img_DC, img_départ)
 'récupération des colonnes de mon image
 larg = bm_départ.bmWidth
 haut = bm_départ.bmHeight
 p = larg * haut
 For x1 = 0 To larg - 1
    n = 0
    l = 1
    For y1 = 0 To haut - 1
        pix = GetPixel(img_DC, Int(x1), Int(y1))
        If n = 0 Then
            If pix = 0 Then
                n = y1 - 1
                l = 1
            End If
        Else
            If pix = 0 Then
                l = l + 1
            Else
                ReDim Preserve Tablo(0 To 3, 0 To m)
                Tablo(0, m) = x1
                Tablo(1, m) = n
                Tablo(2, m) = n + l + 1
                Tablo(3, m) = 0
                m = m + 1
                n = 0
                l = 0
            End If
        End If
    Next
 Next

'reprise dans la colonne 4 des répétitions

 For i = LBound(Tablo, 2) To UBound(Tablo, 2)
    MonDico(Tablo(0, i)) = MonDico(Tablo(0, i)) + 1
 Next
 For i = LBound(Tablo, 2) To UBound(Tablo, 2)
    Tablo(3, i) = MonDico(Tablo(0, i))
 Next

 'Création Tableau final
 Rep = 0
 Ind = 0
 x = 0
 While Ind < UBound(Tablo, 2)
    If Tablo(3, Ind) = Rep Then
        For i = 0 To 2
            ReDim Preserve tabfin(0 To 2, 0 To x)
            tabfin(i, x) = Tablo(i, Ind + Rep1 - 1) ' et non Ind+Rep1
        Next i
        If Rep1 = 1 Then Rep1 = Rep Else Rep1 = Rep1 - 1
        Ind = Ind + Rep
        x = x + 1
    Else
        Rep = Tablo(3, Ind)
        Rep1 = Rep
    End If
 Wend
 Worksheets("F2").Range("G2").Resize(UBound(tabfin, 2) + 1, UBound(tabfin, 1) + 1) = Application.Transpose(tabfin)

 Set img_départ = Nothing
 DeleteObject SelectObject(img_DC, img_DCOld)
 DeleteDC img_DC
End Sub