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

[jiby]

Bonjour à tous,

Après moulte recherche sur internet, ce problème me taraude encore l'esprit.

Je vais essayer de vous expliquer ma situation : (j'ai mis un fichier excel en pièce jointe)

Un logiciel me donne automatiquement une feuille excel contenant des données variante comme la feuille "Exemple" ou la feuille "Exemple (2)".

Ce que je cherche à faire, c'est créer une macro me permettant, automatiquement, de fractionner ce tableau en plusieurs feuilles. Le résultat à obtenir quelque soit l'exemple seront les feuilles "Voiture" ET "Moto" ET "Piéton".

Mon problème étant que la macro doit sélectionner la plage de cellule partant de "VOITURE", jusqu'au prochain titre en GRAS.

La Macro doit commencer à prendre en compte une plage de cellule commencent soit par "VOITURE", soit par "MOTO", soit par "PIETON" et seulement ces trois là en sachant qu'il ne sont pas toujours présent dans la liste.

La Macro doit ensuite comprendre que cette plage de cellule se finit par un titre en "GRAS", car, comme montré dans les deux exemples, les titres peuvent avoir des places différentes ainsi que des titres différents comme "VELO" (feuille "Exemple") ou "BUS" (feuille "Exemple (2)) dont la macro ne doit pas prendre en compte les valeurs.


J'espère avoir pus être assez explicite, et vous remercie d'avance.

 

[romain9]

Re : Copier plage de cellule suivant cellule nommé au début et à la fin

Bonjour,

Voilà ce que je te propose comme solution. Exécute la macro et dis moi si elle répond à ton besoin.

 

[jiby]

Re : Copier plage de cellule suivant cellule nommé au début et à la fin

Bonjour romain9,

Je te remercie de ton aide. Ta macro est plus qu'excellente ! J'ai juste fais quelques modifications dans la partie "VOITURE" et tous fonctionne nickel, encore un grand merci pour ton aide.

Pour info voici le code :

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

 

[romain9]

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

Content de savoir que la macro répond à tes besoins

Au sujet de la partie voiture, je me suis rendu compte que sur un des exemples, il me semble que c'est le numéro 2 la macro ne fonctionnait pas totalement : elle me récupérait que la dernière valeur, en l'occurrence le chiffre 4, et pas les autres alors que pour les feuilles suivantes elle récupérait bien toutes les valeurs.

En tout cas c'est tant mieux si tu as pu corriger ce petit problème car là en ce moment j'ai pas trop le temps de me replonger dedans et comme je suis encore débutant en macro, je ne sais pas si j'aurai réussi à trouver la cause du problème.