Diviser une feuille en plusieurs feuilles

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Florian699

XLDnaute Nouveau
Bonjour,

mon problème du jour est le suivant :

j'ai une feuille excel avec 2 colonnes (A et B) et des données dans chacune d'elle. Le nombre de ligne est de un peu de 10000 dans mon fichier final.
Dans la colonne A il y a des n° avec un titre (ex: 37. les chaussures).

Ce que je souhaite faire (mais je n'y arrive pas), c'est de créer automatiquement une nouvelle feuille pour chaque titre de la colonne A (avec le titre sur la nouvelle feuille) est de mettre toutes les données de ce titre (des 2 colonnes A et B) dans cette nouvelle feuille. Et ceci pour tous les titres qu'il rencontrera dans la colonne A. Ceci devrait donnait 256 nouvelles feuilles avec leurs données respectives.

Voilà, voilà

Si quelqu'un pouvait m'aider je le remercie d'avance

Ps je mets une partie de mon fichier en pj
 

Pièces jointes

Juste une petite modification à effectuer :
quand les feuilles se créent, elles le font sur la gauche de la feuille de départ et celle-ci se retrouve en fait à la fin de toutes les feuilles. Et c'est un peu génant.
Il faudrait que la création des feuilles se fassent à la droite de la feuille de départ avec une incrémentation dans l'ordre croissant des feuilles.

Voilà si c'était possible cela m'aiderait bien ...
 
Bonjour Florian, Pierre, le forum,

Une solution voisine dans le fichier joint :
Code:
Sub CreerFeuilles()
Dim n%, t, i&, j&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---ne garde que la 1ère feuille---
For n = Sheets.Count To 2 Step -1
  Sheets(n).Delete
Next
'---crée les feuilles---
t = Sheets(1).UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
  If t(i, 1) Like Val(t(i, 1)) & ".*" Then
    Sheets.Add(After:=Sheets(n)).Name = Val(t(i, 1))
    If n > 1 Then Sheets(1).Rows(j & ":" & i - 1).Copy Sheets(n).[A1]: Sheets(n).Columns.AutoFit
    j = i
    n = n + 1
  End If
Next
Sheets(1).Rows(j & ":" & i).Copy [A1]: Columns.AutoFit
Sheets(1).Select
End Sub
La suppression des feuilles au début permet de les mettre à jour si nécessaire.

Bonne journée.
 

Pièces jointes

Dernière édition:
Re,

S'il y a plusieurs feuilles à ne pas supprimer :
Code:
Sub CreerFeuilles()
Dim a, S As Worksheet, n%, der%, t, i&, j&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
a = Array("Base", "Feuil2", "Feuil3") 'nom des feuilles à ne pas supprimer, à adapter
Set S = Sheets(a(0)) 'feuille source, à adapter
'---supprime les feuilles---
For n = Sheets.Count To 1 Step -1
  If IsError(Application.Match(Sheets(n).Name, a, 0)) Then Sheets(n).Delete
Next
n = Sheets.Count: der = n
'---crée les feuilles---
t = S.UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
  If t(i, 1) Like Val(t(i, 1)) & ".*" Then
    Sheets.Add(After:=Sheets(n)).Name = Val(t(i, 1))
    If n > der Then S.Rows(j & ":" & i - 1).Copy Sheets(n).[A1]: Sheets(n).Columns.AutoFit
    j = i
    n = n + 1
  End If
Next
S.Rows(j & ":" & i).Copy [A1]: Columns.AutoFit
S.Select
End Sub
Fichier (2).

A+
 

Pièces jointes

Dernière édition:
dernière question :
comment puis-je avec le code de Pierre faire en sorte que le nom des feuilles créées = nom de la partie créée ?
exemple : aujourd'hui j'ai comme nome de feuille créée 1., 2., 3. etc ... et je voudrais avoir 1.Les pronoms 2. Greetings. Salutations. Farewells etc ...

Merci d'avance

et voici le code pour rappel

Sub test()
tablo = Sheets("Feuil1").Range("A1:B" & Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row)
debut = 1
nom = "1."
For n = LBound(tablo, 1) + 1 To UBound(tablo, 1)
If (IsNumeric(Left(tablo(n, 1), 1)) And InStr(tablo(n, 1), ".") <> 0) Or n = UBound(tablo, 1) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = nom
Sheets("Feuil1").Range(Cells(debut, 1).Address & ":" & Cells(n - 1, 2).Address).Copy Destination:=ActiveSheet.Range("A1")
debut = n
nom = Split(tablo(n, 1))(0)
End If
Next
End Sub
 
Bonjour,
Code:
Sub CreerFeuilles()
Dim a, S As Worksheet, n%, der%, t, i&, gauche%, j&
a = Array("Base", "Feuil2", "Feuil3") 'noms des feuilles à ne pas supprimer, à adapter
Set S = Sheets(a(0)) 'feuille source, à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---supprime les feuilles---
For n = Sheets.Count To 1 Step -1
  If IsError(Application.Match(Sheets(n).Name, a, 0)) Then Sheets(n).Delete
Next
n = Sheets.Count: der = n
'---crée les feuilles---
t = S.UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
  If t(i, 1) Like Val(t(i, 1)) & ".*" Then
    With Sheets.Add(After:=Sheets(n))
      For gauche = 31 To 1 Step -1 'le nom d'une feuille ne doit pas avoir plus de 31 caractères
        .Name = Left(t(i, 1), gauche)
        If .Name = Left(t(i, 1), gauche) Then Exit For 's'il n'y a pas de caractères interdits
      Next
    End With
    If n > der Then S.Rows(j & ":" & i - 1).Copy Sheets(n).[A1]: Sheets(n).Columns.AutoFit
    j = i
    n = n + 1
  End If
Next
S.Rows(j & ":" & i).Copy [A1]: Columns.AutoFit
S.Select
End Sub
Il faut savoir qu'un nom de feuille ne doit pas avoir plus de 31 caractères et qu'il y a des caractères interdits.

Je découvre ici, avec la 3ème feuille créée, qu'en plus le dernier caractère ne doit pas être une apostrophe '.

Fichier (3).

A+
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Résolu(e)
Microsoft 365 DateDif()
Réponses
5
Affichages
193
Retour