Transformer "listing" en base de données exploitable

Sub listing()
Dim x As Long
Dim tablo()
With Sheets("Rapport 1")
    For Each c In Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
        If c = "ACTIVI" Then
            codeAct = c.Offset(0, 1)
            ligne = 1
            Do While c.Offset(ligne, 0) = "RESSOU"
                ReDim Preserve tablo(3, x)
                tablo(0, x) = .Cells(c.Offset(ligne, 0).Row, 1).Value
                tablo(1, x) = codeAct
                tablo(2, x) = .Cells(c.Offset(ligne, 0).Row, 3).Value
                tablo(3, x) = .Cells(c.Offset(ligne, 0).Row, 4).Value
                ligne = ligne + 1
                x = x + 1
            Loop
        End If
    Next c
End With
With Sheets("Feuil1")
    .Cells(2, 1).Resize(x, 4) = Application.Transpose(tablo)
End With
End Sub

Sub t()
    For i = 2 To Range("a1").End(xlDown).Row
        If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = "RESSOU" Then
        x = Application.Match(Cells(i, 1), Range("a:a"), 0)
        Cells(i, 4) = Cells(x, 3)
        Cells(x, 6) = "non"
        End If
    Next
End Sub