Crée des feuilles si

Bonsoir

Voici une macro commentée qui fait cela. Elle doit être placée dans un
module standard du classeur

Sub ajouterFeuilles()
Dim DerniereLigne As Long, Ligne As Long
Dim Plage As Range
Dim FeuilleDepart As Worksheet

'Définir la feuille de départ pour pouvoir y revenir
Set FeuilleDepart = Worksheets("feuil3")
' Définir la ligne de la dernière cellule utilisée ds la colonne
DerniereLigne = Range("a65536").End(xlUp).Row
' Démarrer à la ligne 1
Ligne = 1

' On boucle tout le temps. C'est à l'intérieur
' de la boucle que l'on testera pour en sortir
Do
' Si la section ne fait qu'une ligne
If FeuilleDepart.Range("a" & Ligne + 1) = "" Then
' on ne prend qu'une seule cellule
Set Plage = FeuilleDepart.Range("a" & Ligne)
Else
' sinon, on prend toutes les cellules de la section
Set Plage = FeuilleDepart.Range("a" & Ligne & ":a" & _
FeuilleDepart.Range("a" & Ligne).End(xlDown).Row)
End If
' On teste pour sortir de la boucle
If Ligne + Plage.Rows.Count - 1 > DerniereLigne Then Exit Do
' On ajoute une feuille
Worksheets.Add
'On copie la plage dans la nouvelle feuille
Plage.Copy Destination:=Range("a1")
' On additionne les lignes pour repartir
' à la section suivante
Ligne = Ligne + Plage.Rows.Count + 1
' On boucle
Loop
End Sub


--
Cela convient-il?
----
Pierre Fauconnier
"C'est lorsqu'il y a un temps mort qu'il faut tuer le temps..."
(remplacer NOSPAM par pfi pour me répondre. Merci)
eis wrote:

Bonjour à tous
A partir d'une feuille avec un nombre variable de zones de données
séparées par des lignes vides (3 zones dans l'exemple suivant) :

xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
ligne vide
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
ligne vide
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
Je voudrais ajouter automatiquement autant d'onglets que de zones,
copier les valeurs de la 1ère zone, les coller dans le 1er onglet
crée, copier les valeurs de la 2ème zone et les coller dans le 2ème
onglet crée etc...

Bonjour,

Une variante :
Sub Toto()
f = ActiveSheet.Name
der = Range("a65000").End(xlUp).Row
n = Application.CountBlank(Range("a1:a" & der))
Range("a1").Select
For cpt = 1 To n + 1
ActiveCell.CurrentRegion.Copy
Sheets.Add
ActiveSheet.Paste
Sheets(f).Select
If cpt <> n + 1 Then _
Range(ActiveCell, Range("a" & der)).Find("").Offset(1,
0).Activate
Next
Application.CutCopyMode = False
End Sub

Camille

-----Message d'origine-----
Bonjour à tous
A partir d'une feuille avec un nombre variable de zones
de données séparées

par des lignes vides (3 zones dans l'exemple suivant) :

xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
ligne vide
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
ligne vide
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
Je voudrais ajouter automatiquement autant d'onglets que
de zones, copier

les valeurs de la 1ère zone, les coller dans le 1er
onglet crée,

copier les valeurs de la 2ème zone et les coller dans le
2ème onglet crée

etc...




.

merci je vais expérimenter tout ca
"Ellimac" <PasDePubellimacNiSpam_cremelier@hotmail.com> a écrit dans le
message de news: 0b9801c38cb0$bc7e6a80$a401280a@phx.gbl...
Bonjour,

Une variante :
Sub Toto()
f = ActiveSheet.Name
der = Range("a65000").End(xlUp).Row
n = Application.CountBlank(Range("a1:a" & der))
Range("a1").Select
For cpt = 1 To n + 1
ActiveCell.CurrentRegion.Copy
Sheets.Add
ActiveSheet.Paste
Sheets(f).Select
If cpt <> n + 1 Then _
Range(ActiveCell, Range("a" & der)).Find("").Offset(1,
0).Activate
Next
Application.CutCopyMode = False
End Sub

Camille

-----Message d'origine-----
Bonjour à tous
A partir d'une feuille avec un nombre variable de zones
de données séparées

par des lignes vides (3 zones dans l'exemple suivant) :

xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
ligne vide
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
ligne vide
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
xxxxxxxxxxxxxx
Je voudrais ajouter automatiquement autant d'onglets que
de zones, copier

les valeurs de la 1ère zone, les coller dans le 1er
onglet crée,

copier les valeurs de la 2ème zone et les coller dans le
2ème onglet crée

etc...




.