XL 2013 [RESOLU]Copie Colle avec création onglet

BENAM69

XLDnaute Occasionnel
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

Benam
 

Pièces jointes

  • Prod.xlsx
    14.6 KB · Affichages: 4

sousou

XLDnaute Barbatruc
Bon jour

En collant ce code dans un module de ton fichier ca devrait marcher
Public flag, titre
Sub deb()
flag = 0
With Sheets(1)
Set titre = .Rows(1)
For Each i In .UsedRange.Columns(1).Rows
If i = "" Then Set finpage = i.Offset(-1)
If Left(i, 5) = "Délai" And flag = 0 Then
Set debpage = i: flag = 1
Else
If Left(i.Offset(1, 0), 5) = "Délai" And flag = 1 Then
Set finpage = i.Offset(-1)
Call colle(debpage, finpage)
flag = 0
End If
End If

Next

Call colle(debpage, finpage)

End With

End Sub
Sub colle(deb, fin)
Set zone = deb.Parent.Range(deb.Address & ":" & fin.Offset(1, 0).Address)
'MsgBox zone.Address
Set nf = Sheets.Add
zone.Copy nf.Range("a5")
titre.Copy nf.Rows(4)
nom = Right(deb, Len(deb) - InStr(1, deb, ":"))
nom = Replace(nom, "/", "_")
nf.Name = nom
End Sub
 

BENAM69

XLDnaute Occasionnel
Bon jour

En collant ce code dans un module de ton fichier ca devrait marcher
Public flag, titre
Sub deb()
flag = 0
With Sheets(1)
Set titre = .Rows(1)
For Each i In .UsedRange.Columns(1).Rows
If i = "" Then Set finpage = i.Offset(-1)
If Left(i, 5) = "Délai" And flag = 0 Then
Set debpage = i: flag = 1
Else
If Left(i.Offset(1, 0), 5) = "Délai" And flag = 1 Then
Set finpage = i.Offset(-1)
Call colle(debpage, finpage)
flag = 0
End If
End If

Next

Call colle(debpage, finpage)

End With

End Sub
Sub colle(deb, fin)
Set zone = deb.Parent.Range(deb.Address & ":" & fin.Offset(1, 0).Address)
'MsgBox zone.Address
Set nf = Sheets.Add
zone.Copy nf.Range("a5")
titre.Copy nf.Rows(4)
nom = Right(deb, Len(deb) - InStr(1, deb, ":"))
nom = Replace(nom, "/", "_")
nf.Name = nom
End Sub

Salut Sousou ^^

Je te remercie grandement pour ta réponse et ton code ^^

C'est parfait ^^,

Tu sais si c'est normal que les données de la colonne B à K ne sont pas collées ?
J'ai que les données de la colonne A qui sont collées.

Mais ce n'est pas grave je vais chercher un peu.

Merci mille fois ^^

A+

Benam
 

Discussions similaires

Haut Bas