Copier plusieur ligne dans un nouvelle onglet en VBA

Axis

XLDnaute Nouveau
Bonjour à tous,

Je suis nouveau sur le forum et j'aurais besoin d'aide sur mon fichier excel.
Je précise que je suis totalement novice en VBA.
Je voudrais pouvoir copier plusieurs lignes en fonction de la valeur d'une cellule dans un nouvel onglet.
La nomenclature est variable en longueur mais la présentation reste la même.

ex: la cellules N5 si= BC(machine) alors elle me copie la ligne 5 à 8 avec l'image, quelle va me coller dans un nouvel onglet appeler BC si il n'existe pas.

Ceci afin de pouvoir classer les différentes machines en plusieurs onglet.

Une fois le trie des machines fait j'aimerais qu'elle se classe en fonction de leur longueurs.

J'ai essayer à l'aide des différents forum que j'ai pu lire, et j'ai adapter une VBA trouvé.
Le problème est qu'il me copie qu’une seul ligne et sans l'image.
Je met ci joint mon fichier que j'ai commencé à créer.
 

Pièces jointes

  • Classeur1.xlsm
    49.9 KB · Affichages: 51
  • Classeur1.xlsm
    49.9 KB · Affichages: 56
Dernière modification par un modérateur:

Axis

XLDnaute Nouveau
Re : Copier plusieur ligne dans un nouvelle onglet en VBA

Pour essayer d'être plus précis dans ma question.
Je pense que mon problème viens de cette commande:

Sub Macro1()
Dim ong As Worksheet 'déclare la variable ong (ONGlet)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dest As Range 'déclare la variable dest (DESTination)

'vérification de l'existance de l'onglet "BC"
For Each ong In Sheets 'boucle sur tous les onglets du classeur
If ong.Name = "BC" Then GoTo suite 'si le nom de l'onglet est "BC" va à l'étiquette "suite"
Next ong 'prochain onglet de la boucle

Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un nouvel onglet à la fin
ActiveSheet.Name = "BC" 'nomme l'onglet "BC"
Sheets("Nomenclature").Rows(1).Copy Sheets("BC").Range("A1") 'récupère les en-tête de la première ligne
Sheets("Nomenclature").Rows(2).Copy Sheets("BC").Range("A2") 'récupère les en-tête de la première ligne

suite: 'étiquette
For Each ong In Sheets 'boucle 1 : sur tous les onglets du classeur
If ong.Name <> "BC" Then 'condition 1 : si le nom de l'onglet est différent de "BC"
Set pl = ong.Range("N4:N" & ong.Range("N65536").End(xlUp).Row) 'définit la plage pl
For Each cel In pl 'boucle 2 : sur toutes les cellule cel de la plage pl
If cel.Value = "BC" Then 'condition 2 : si la valeur de la cellule est "BC"
Set dest = Sheets("BC").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination
cel.EntireRow.Copy dest 'copie la ligne entière de la cellule cel dans la cellule de destination dest
End If 'fin de la condition 2
Next cel 'prochaine cellule cel de la boucle 2
End If 'fin de la condition 1
Next ong 'prochain onglet de la boucle 1

End Sub


Car elle me copie que la ligne entière par rapport a la cellule qui trouve "BC". Hors je voudrais cette ligne + 2 à 3 ligne en dessous avec l'image.
 
Dernière modification par un modérateur:

Discussions similaires

Statistiques des forums

Discussions
312 203
Messages
2 086 191
Membres
103 152
dernier inscrit
Karibu