[RESOLU] Copier plage de cellule suivant cellule nommé au début et à la fin

Dim TabDynamique1() As Variant, TabDynamique2() As Variant, TabDynamique3() As Variant


Sub Création_Tableaux()

Dim vAdresse As String
Dim x As Integer, y As Integer, i As Integer, j As Integer, k As Integer, NumElement As Integer, NumElement2 As Integer, NumElement3 As Integer, vCompteur As Integer, vCompteur2 As Integer, _
vCompteur3 As Integer, vNombre As Integer
Dim vCellule As Range
Dim Valeur As Variant

Sheets.Add After:=Sheets(Sheets.Count)

Sheets(2).Name = "Voiture"
Sheets(3).Name = "Moto"
Sheets(4).Name = "Pieton"

Worksheets("Exemple").Select
vAdresse = Range("A1").End(xlDown).Address
Range("A1:" & vAdresse).Select
x = Selection.Rows.Count
vCompteur = 0
vCompteur2 = 0
vCompteur3 = 0
NumElement = 1
NumElement2 = 1
NumElement3 = 1
For i = 1 To x
Set vCellule = Cells(i, 1)
Valeur = vCellule.Value
    Select Case Valeur
    Case "VOITURE"
        For j = i + 1 To x
           If Cells(j, 1).Font.Bold = False Then
           vCompteur = vCompteur + 1
           Else
        Exit For
           End If
        Next
    ReDim TabDynamique1(1 To vCompteur)
    TabDynamique1(vCompteur) = vCompteur
        For y = 1 To x
            If Cells(y, 1).Value = "VOITURE" Then
                For k = 1 To vCompteur
                    If Cells(y, 1).Offset(k, 0).Font.Bold = False Then
                    TabDynamique1(NumElement) = Cells(y, 1).Offset(k, 0).Value
                    NumElement = NumElement + 1
                    End If
                Next k
            End If
        Next y
    Case "MOTO"
        For j = i + 1 To x
           If Cells(j, 1).Font.Bold = False Then
           vCompteur2 = vCompteur2 + 1
           Else
        Exit For
           End If
        Next
    ReDim TabDynamique2(1 To vCompteur2)
    TabDynamique2(vCompteur2) = vCompteur2
        For y = 1 To x
            If Cells(y, 1).Value = "MOTO" Then
                For k = 1 To vCompteur2
                    If Cells(y, 1).Offset(k, 0).Font.Bold = False Then
                    TabDynamique2(NumElement2) = Cells(y, 1).Offset(k, 0).Value
                    NumElement2 = NumElement2 + 1
                    End If
                Next k
            End If
        Next y
    Case "PIETON"
         For j = i + 1 To x
           If Cells(j, 1).Font.Bold = False Then
           vCompteur3 = vCompteur3 + 1
           Else
        Exit For
           End If
        Next
    ReDim TabDynamique3(1 To vCompteur3)
    TabDynamique3(vCompteur3) = vCompteur3
        For y = 1 To x
            If Cells(y, 1).Value = "PIETON" Then
                For k = 1 To vCompteur3
                    If Cells(y, 1).Offset(k, 0).Font.Bold = False Then
                    TabDynamique3(NumElement3) = Cells(y, 1).Offset(k, 0).Value
                    NumElement3 = NumElement3 + 1
                    End If
                Next k
            End If
        Next y
    End Select
Next i
Worksheets(2).Activate
For vNombre = 1 To vCompteur
Cells(vNombre, 1).Value = TabDynamique1(vNombre)
Next

Worksheets(3).Activate
For vNombre = 1 To vCompteur2
Cells(vNombre, 1).Value = TabDynamique2(vNombre)
Next

Worksheets(4).Activate
For vNombre = 1 To vCompteur3
Cells(vNombre, 1).Value = TabDynamique3(vNombre)
Next
End Sub