XL2013 - Copie Coller et ouvrir onglet

Bonjour le forum,

J'ai cherché dans différents forum pour réaliser une macro. Mais je n'ai pas trouvé ce que je cherche.

Je voulais savoir si cela était possible de réaliser les tâches suivantes :

J'ai un fichier de données que l'on extrait et j'ai besoin de créer automatiquement des onglets en fonction d'un critère et copier coller les lignes correspondantes dans ces onglets.

Je vous explique :

Sur mon fichier, la première ligne de données doit à chaque fois être copier coller sur tous les onglets qui vont être créer automatiquement et mise en 4ème ligne. (Cette première ligne de données correspondant aux en-tête de données.)

Sur la colonne A, la macro vérifie les lignes, à chaque fois qu'il identifie : "Délai confirmé :", il va ouvrir un nouvel onglet, copier coller :

En 4ème ligne : La première ligne (qui est l'en-tête de données)

A partir de la ligne 5 : les lignes de données après la cellule "Délai confirmé :" jusqu'à ce qu'il rencontre à nouveau "Délai confirmé".

A chaque fois qu'il va identifier "Délai confirmé :" il va créer un nouvel onglet et refaire la même chose jusqu'à la dernière ligne.

Si possible chaque onglet créer va porter le nom de la cellule qui contient "Délai confirmé :" avec les semaines inscrites dans cette même cellule. Les semaines varient à chaque fois.

Je vous met en PJ un fichier pour que vous puissiez voir à quoi ressemble cette extraction.

J'espère avoir été explicite sur ma requête.

Après le reste de la macro je pourrais me débrouiller.

Je vous remercie par avance de votre aide

Namco

Bonjour Namco, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NO As String 'déclare la variable NO (Nom de l'Onglet)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim FS As Integer 'déclare la variable FS (Fin de Section)
Dim R As Range 'déclare la variable R (Recherche)

Set OS = Worksheets("Sheet1") 'définit l'onglet OS
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet DL
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
    If Left(TV(I, 1), 16) = "Délai confirmé :" Then 'condition : si la donnée de TV commence par "Délai confirmé :"
        NO = Replace(Split(TV(I, 1), ":")(1), "/", "_") 'réfinit le nom de l'onglet NO
        Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set OD = ActiveSheet 'définit l'onglet destination OD
        OD.Name = NO 'renomme l'onglet OD
        OD.Range("A1").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1) 'renvoie la premiere ligne du tableau des valeurs
        Set R = OS.Columns(1).Find("Délai confirmé", OS.Cells(I, "A"), xlValues, xlPart) 'refinit la recherche R (Recherche "Délai confirmé :" après la ligne I dans la colonne A de l'onglet OS
        If Not R Is Nothing Then FS = R.Row - 1 'si il existe au moins une occurrence trouvé definit la fin de section FS
        If FS < I Then FS = DL 'si FS est inférieure à la ligne I
        'copie, de l'onglet source OS, la plage des lignes I à FS et la colle dans A2 de l'onglet OD
        OS.Range(OS.Cells(I, "A"), OS.Cells(FS, UBound(TV, 2))).Copy OD.Range("A2")
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

Salut ThauThème

Juste Énorme !!

Merci c'est exactement ce que je voulais.

Mais c'est possible quand il démarre le collage sur les nouveaux onglets qu'il démarre en 4 lignes ?

J'ai besoin de mettre des éléments sur les lignes 1 à 3 des nouveaux onglets.

Sinon Parfait ^^

A+

Namco