Copier cellules dans d'autres suivant éléments

Bonjour à tous.

Je remplis des formulaires régulièrement et je voudrais améliorer la vitesse de traitement.

Vous pouvez trouver ci-joints, l'état-1, qui est ce que j'obtiens d'un logiciel d'ERP,

et l'état-2, qui est ce que je veux avoir après lancement d'une macro.

Ma demande :

1 Il faut que le macro saute les premières lignes vides ainsi que la ligne grisée.

2 Arrivée à la première ligne en gras, la macro doit prendre la cellule de la colonne E, et la copier,

3 La coller dans toutes les casses de la colonne B, jusqu'à la prochaine ligne en gras,

4 Reprendre étapes 2 et 3, jusqu'à la fin du tableau

Il faut que les cellules soit vides dans la colonne B sur les lignes en gras.

Vous pouvez faire autrement si vous le souhaitez, du moment que le résultat est le même.

Trouvez ci-joint, un image explicative qui vous éclaircira peut-être ma demande.

Merci.

Hello,

Voilà une proposition. Je te laisse le soin de vérifier qu'elle fonctionne selon ton besoin

Chez moi tout semble correcte.

Pour l'exécution, il y a un garde-fou si tu lances la macro sur une page sans données. Après 50 lignes testée non conformes, le programme s'arrête.

Merci, c'est très bien !

Pourrais tu juste rajouter dans la macro, le code pour que les cellules copiées, soit en gras ?

Et ce serra parfait.

Il suffit de remplacer(rajouter)

Feuil1.Cells(numLigne, 2) = numeroComposant

Par

Feuil1.Cells(numLigne, 2) = numeroComposant
Feuil1.Cells(numLigne, 2).Font.Bold = True

Bonjour et merci.

J'ai amélioré un peu la macro de mon côté, j'aurais juste une dernière modification à faire apporter.

Ci-joint, l'état Vierge, l'état de base

Ci-joint, l'état 1, l'état dans lequel est la table, après utilisations du macro

Et ci-joint, l'état 2, l'état dans lequel je voudrais que la macro termine de mettre en forme la table.

Pour résumer, il faudrait que le macro, après avoir fait ce qu'il fait actuellement, prennent toutes les lignes avec un niveau d'éclatement ".1" (celle que l'ont peut voir en gras, sans le titre, bien sur)

Qu'elle créer au dessus de la ligne grisée, un nombre de ligne égale au nombre de lignes sélectionner précédemment, et que la macro, copie-colle ces mêmes lignes.

Puis accessoirement, retourne le filtre de la colonne C à "tous".

Merci.

Sub CSK2()
'
' Macro3 Macro
' Macro enregistrée le 24/03/2016 par vaf
'

Dim numLigne As Integer
Dim numeroComposant As String

    Range("A1:H1").Select
    Selection.AutoFilter
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Sous-Ensemble"
    Selection.AutoFilter Field:=3, Criteria1:=".1"
    Cells.Select
    Range("K10").Activate
    Selection.Font.Bold = True
    Range("C1").Select
    Selection.AutoFilter Field:=3

Range("A1").Select

numLigne = 1

Dim ligneDivision As Integer

While Feuil1.Cells(numLigne, 1) <> "Division" And numLigne < 50
    numLigne = numLigne + 1
    If Feuil1.Cells(numLigne, 1) = "Division" Then ligneDivision = numLigne
Wend
If numLigne = 50 Then Exit Sub 'pour éviter un plantage.

numLigne = numLigne + 1 'on est à la premiere ligne de données
While Feuil1.Cells(numLigne, 1) <> ""
    If Feuil1.Cells(numLigne, 1).Font.Bold = True Then
        'on stocke la donnée à afficher:
        numeroComposant = Feuil1.Cells(numLigne, 5)
        numLigne = numLigne + 1
        While Feuil1.Cells(numLigne, 1).Font.Bold = False And Feuil1.Cells(numLigne, 1) <> ""
            Feuil1.Cells(numLigne, 2) = numeroComposant
            Feuil1.Cells(numLigne, 2).Font.Bold = True
            numLigne = numLigne + 1
        Wend
    Else
        numLigne = numLigne + 1
    End If
Wend

suiteTri ligneDivision

End Sub

Sub suiteTri(ligneDivision As Integer)
If ligneDivision < 1 Then Exit Sub

Dim derniereLigne As Integer
'on récupère la derniere ligne et on applique le filtre
derniereLigne = Cells(Rows.Count, "A").End(xlUp).Row
Range("$A$" & ligneDivision & ":$H$" & derniereLigne).AutoFilter Field:=3, Criteria1:=".1"
'on recalcule la nouvelle derniere ligne et on copie les données
derniereLigne = Cells(Rows.Count, "A").End(xlUp).Row

Dim plage As Range
Set plage = Range("$A$" & ligneDivision & ":$H$" & derniereLigne)

End Sub

Un début de code (une nouvelle procédure).

Elle applique un filtre et définit la plage à copier, mais je ne sais pas comment coller cette plage en insérant des lignes, donc cette partie finale reste à faire.