Créer nb feuille(s) autant de fois que cela est nécessaire avec conditions

Le 06/05/2022 à 15:16

Bonjour,

Débutant en VBA, j'aimerais que l'on m'aide sur le développement d'une macro s'il vous plait. En fait, je dispose d'une base de données en Feuil2 et j'aimerais fractionner les données sur 20 lignes maximum pour chaque feuille. Exemple: si en Feuil2 j'ai des données sur 50 lignes, en Feuil3 j'aurai 20 lignes, en Feuil4 j'aurais 20 lignes et en Feuil5 10 lignes. J'aimerais aussi dans la foulée renommer ces feuilles: Export3, Export4 et Export5 dans le cas de mon exemple.

Je poste ici le fichier avec le résultat que j'aimerais obtenir:

10donnees.xlsm (12.93 Ko)

Merci à vous

JB

Le 06/05/2022 à 16:42

Bonjour JeanBaptisteP, le forum,

Un essai...

6jbp.xlsm (29.42 Ko)

Cordialement,

Le 06/05/2022 à 16:50

Bonjour xorsankukai,

Merci beaucoup pour votre retour, cela répond à mes besoins. J'ai vu que vous avez réalisé un calcul par VBA pour connaître le nombre d'onglets à créer

derlig = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
   nb = derlig / 20 'définit le nombre d'onglets "Export"
    x = IIf(nb - Int(nb) = 0, Int(nb), Int(nb) + 1) 'si décimal:arrondi à l'entier >
   cp = 1: depart = 1

Seulement si cela peut vous aider, on peut couper/coller les données présentes en Feuil2 vers une feuille Export*

Je vous expose cette idée au cas où si cela peut simplifier un peu le code, je ne connais pas assez VBA pour savoir ce qui est le plus facile à développer :)

Encore merci

JB

Le 06/05/2022 à 17:14

Re,

Merci pour ton retour,

Effectivement, on peut se passer du calcul...bonne remarque...

Sub test()
 Dim tb, sh As Worksheet
 Dim cp%, depart&, derlig&

 Application.ScreenUpdating = False

 '********************************************************************
  'efface les feuilles "Export"
 '*******************************************************************
 For Each sh In ThisWorkbook.Worksheets
  Application.DisplayAlerts = False
   If sh.Name Like "Export*" Then sh.Delete
  Application.DisplayAlerts = True
 Next sh
 '********************************************************************
   derlig = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
   cp = 1: depart = 1
    Do While depart <= derlig
     tb = Sheets("Feuil2").Range("A" & depart).Resize(20, 1)
     Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
      With ActiveSheet
      .Name = "Export" & cp
      .Range("A1").Resize(20, 1) = tb
      End With
     Erase tb
      'Sheets("Feuil2").Activate
      depart = depart + 20
      cp = cp + 1
   Loop
End Sub
10jbp-v2.xlsm (20.84 Ko)

Cordialement,

Le 10/05/2022 à 00:01

Bonjour xorsankukai,

C'est parfait, merci beaucoup !!!! :)

Par contre, comment adapter le code pour sélectionner les cellules "A à D & depart" et non pas uniquement les cellules "A & depart" ?

Je sais que ça se situe à cet endroit mais comment définir la plage ?

tb = Sheets("Feuil2").Range("A" & depart).Resize(20, 1)

Encore un grand merci à toi!

JB

Le 10/05/2022 à 12:55

Bonjour,

Essaies ainsi:

Sub test()
 Dim tb, sh As Worksheet
 Dim cp%, depart&, derlig&

 Application.ScreenUpdating = False

 '********************************************************************
  'efface les feuilles "Export"
 '*******************************************************************
 For Each sh In ThisWorkbook.Worksheets
  Application.DisplayAlerts = False
   If sh.Name Like "Export*" Then sh.Delete
  Application.DisplayAlerts = True
 Next sh
 '********************************************************************
   derlig = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
   cp = 1: depart = 1
    Do While depart <= derlig
     tb = Sheets("Feuil2").Range("A" & depart).Resize(20, 4)
     Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
      With ActiveSheet
      .Name = "Export" & cp
      .Range("A1").Resize(20, 4) = tb
      End With
     Erase tb
      'Sheets("Feuil2").Activate
      depart = depart + 20
      cp = cp + 1
   Loop
End Sub
.Resize(20, 4)     '=====> (.Resize(nb lignes,nb colonnes)

Cordialement,

Le 06/06/2022 à 15:18

Bonjour xorsankukai,

Merci pour votre proposition, cela fonctionne très bien. Seulement je souhaiterais modifier le code mais je ne n'arrive pas à m'en sortir. Actuellement toutes les feuilles Export sont limitées à 20 lignes de données lors de l’exécution de la macro proposée précédemment.

Dorénavant, j'aimerais que le nombre de lignes pour la 1ère feuille Export uniquement varie en fonction du résultat de la variable nblignes (renseigné depuis inputbox). Pour les autres feuilles Export on conserve les 20 lignes :)

Seulement je ne sais pas où placer ma variable nblignes dans la macro que vous m'avez proposée précédemment, pourriez-vous m'aider svp ? :)

Sub test()
 Dim tb, sh As Worksheet
 Dim cp%, depart&, derlig&

 Application.ScreenUpdating = False

 '********************************************************************
  'efface les feuilles "Export"
 '*******************************************************************
 For Each sh In ThisWorkbook.Worksheets
  Application.DisplayAlerts = False
   If sh.Name Like "Export*" Then sh.Delete
  Application.DisplayAlerts = True
 Next sh
 '********************************************************************
nb = Application.InputBox("Nombre de lignes à retenir pour la feuille Export1.", Type:=1)

   derlig = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
   cp = 1: depart = 1
    Do While depart <= derlig
     tb = Sheets("Feuil2").Range("A" & depart).Resize(20, 4)
     Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
      With ActiveSheet
      .Name = "Export" & cp
      .Range("A1").Resize(20, 4) = tb
      End With
     Erase tb
      'Sheets("Feuil2").Activate
      depart = depart + 20
      cp = cp + 1
   Loop
End Sub
Un grand merci pour votre aide

JB
Le 08/06/2022 à 18:41

Bonjour,

Un essai....

Sub test()
 Dim tb, sh As Worksheet
 Dim cp%, depart&, derlig&, x

 Application.ScreenUpdating = False

 '********************************************************************
  'efface les feuilles "Export"
 '*******************************************************************
 For Each sh In ThisWorkbook.Worksheets
  Application.DisplayAlerts = False
   If sh.Name Like "Export*" Then sh.Delete
  Application.DisplayAlerts = True
 Next sh

 '********************************************************************
 'inputbox
 '********************************************************************
 x = InputBox("Renseignez un nombre svp :", "Excel")
 If x = "" Or x = vbNullString Then: On Error GoTo 0: Exit Sub
 '********************************************************************

   derlig = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
 '********************************************************************
 'Traitement de la première feuille
 '********************************************************************
   Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
      With ActiveSheet
      .Name = "Export" & 1
      If x = 0 Then GoTo suite
       tb = Sheets("Feuil2").Range("A1").Resize(x, 1)
      .Range("A1").Resize(x, 1) = tb
      End With
  '*******************************************************************
  'Traitement des feuilles suivantes
  '*******************************************************************

suite:
   cp = 2: depart = x + 1
    Do While depart <= derlig
     tb = Sheets("Feuil2").Range("A" & depart).Resize(20, 1)
     Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count)
      With ActiveSheet
      .Name = "Export" & cp
      .Range("A1").Resize(20, 1) = tb
      End With
     Erase tb
      'Sheets("Feuil2").Activate
      depart = depart + 20
      cp = cp + 1
   Loop
End Sub
16fractionner-v2.xlsm (23.33 Ko)


ThauThème t'a également répondu ici: https://forum.excel-pratique.com/excel/fractionner-donnees-d-une-feuille-excel-en-feuilles-export-av...

Cordialement,

Le 09/06/2022 à 19:27

Bonsoir xorsankukai,

Merci pour votre proposition cela répond à ce que je souhaite faire. Par contre sauriez-vous me dire comment limiter la saisie à la valeur 60 maximum dans le inputbox ?

Effectivement Thauthème propose une solution qui fonctionne bien aussi, j'ai préféré créer un nouveau sujet car il était légèrement différent de celui-ci :)

Un grand merci une nouvelle fois :)

JB

Le 09/06/2022 à 20:51

Bonsoir JeanBaptisteP, le forum,

Effectivement Thauthème propose une solution qui fonctionne bien aussi, j'ai préféré créer un nouveau sujet car il était légèrement différent de celui-ci :)

Pas de souci, mais pense à lui répondre sur l'autre fil, ThauThème a fait l'effort de te fournir un code tout commenté,

Par contre sauriez-vous me dire comment limiter la saisie à la valeur 60 maximum dans le inputbox ?

Une proposition....à tester....

14fractionner-v3.xlsm (23.65 Ko)

Cordialement,

Le 26/06/2022 à 23:06
Bonsoir xorsankukai,

Merci pour votre proposition, cela fonctionne bien :) Je me demandais à tout hasard, est-il possible de limiter cette valeur lors de la saisie et non lors de la vérification après voir cliqué sur OK ? Si cela est trop complexe à développer, on abandonne c'est très bien comme ça :)

Bonne soirée
JB
Le 27/06/2022 à 12:09

Bonjour JeanBaptisteP, le forum,

Une alternative avec un UserForm au lieu d'une InputBox...

A tester...

13fractionner-v4.xlsm (25.54 Ko)

Cordialement,

Le 27/06/2022 à 22:09
Bonsoir xorsankukai,

Merci beaucoup, je vais l'intégrer à mon projet ! Puis-je revenir vers vous si je rencontre un souci ?

Bonne soirée :)

JB
Le 29/06/2022 à 17:11

Bonjour,

Merci pour le retour,

Puis-je revenir vers vous si je rencontre un souci ?

Le forum est là pour ça,

Bonne continuation,

Rechercher des sujets similaires à "creer feuille autant fois que cela necessaire conditions"