Limite de feuille .??

  • Initiateur de la discussion Domi
  • Date de début
D

Domi

Guest
Bonjour tou le monde !!

J'ai un petit souçi au nivo dune macro qui me sert à copié une feuille nommé "MODELE" et a collé sur une feuille X.
Je mexplique je rentre mé informations sur la feuille modele et grace a une macro je copie celle ci et je la colle sur une otre ! cette otre et ainsi de suite. le probleme c que le je sui arrivé à 30 feuilles et je ne pe pa allé plu loin il me met un message derreur ! y a til une solution ??

JE vou donne a toute fin utile le code VBA :

Sub save()
Sheets("Modele").Activate
If Range("B5").Value = "" Or Range("E5").Value = "" Or Range("E7").Value = "" Or Range("H5").Value = "" Or Range("B7").Value = "" Or Range("H7").Value = "" Or Range("E11").Value = "" Or Range("H11").Value = "" Or Range("K15").Value = "" Or Range("F19").Value = "" Or Range("e23").Value = "" Or Range("d28").Value = "" Then
reponse = MsgBox("Tous les champs sont remplis la peut être ?", vbCritical, "Attention")
Exit Sub
Exit Sub
Else
Sheets("Tableau").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Sheets("Modele").Range("B5").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("E5").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("H5").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("H6").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("B7").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("E7").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("H7").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("E11").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("H11").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("a40").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("K15").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("d28").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f29").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f30").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f31").Value

ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f32").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f33").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f34").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f35").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f36").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f37").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f38").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f39").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f40").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f41").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f42").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f43").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f44").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f45").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f46").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Modele").Range("f47").Value
Range("A3:ae65536").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Sheets("Modele").Select
Range("a1").Select
End If
Set modèle = ThisWorkbook.Worksheets("Modele")
Dim creation
creation = MsgBox("ETES VOUS CERTAINS ?", vbOKCancel)
If creation = vbCancel Then Range("b5").Select Else
If creation = vbOK Then modèle.Copy After:=modèle
ActiveSheet.Name = Range("e11")
Sheets("Modele").Select
Range("E22,B5,E5,H5,h6,B7,H7,E11,f19,H11,K15,g28,c28,d28,k19").Select
Range("D31,a28,a42") = 1
Range("E31,E32,E33,E34,E35,E36,E37,E38,E39,E40,E41,E42,E43,E44,E45,E46,E47,e48,e49,e50,e51,e52") = faux
Selection.ClearContents
Range("a1").Select
Sheets("accueil").Select
Exit Sub
End Sub
 
Z

Zon

Guest
Bonsoir Domi,

Pas sympas d'avoir cassé un fil car tu utilises la même macro que dans le Lien supprimé même si ce n'est pas la même question.


Qui plus est pour la première question de ce fil tu ne m'as toujours pas répondu si ma solution sur le problème du tri te convenait...




Alors je veux bien t'aider mais j'aimerais avoir des réponses et déjà me dire quel est ton message d'erreur ?


A+++


PS:
4 - La suite et le suivi de la Question

a) Généralement si les points de 1) à 3) ont été appliqués vous aurez une réponse assez rapidement. Toutefois nous ne somme tous que des bénévols et bénevoles et il se peut que selon la complexité de votre problème un temps de réponse plus long soit nécessaire. Dans tous les cas restez dans le fil initial, ré-ouvrir un nouveau fil pour dire « je n’ai pas eu de réponse à mon post précédent » (surtout si celui-ci date de la veille ou de l’avant-veille) aura un effet négatif inverse.

b) Parfois les réponses peuvent être à cotés, ou bien non applicables, ou encore non-conformes. Dans tous les cas soyez indulgents car même si la réponse est incorrecte, la personne qui l’a rédigée pour vous a essayé de vous aider et a pris de son temps pour çà. Et de la même manière si la réponse ne répond pas entièrement à votre attente, faite le savoir gentillement dans le même fil de discussion. N'en ouvrez pas un autre !

c) N’oubliez pas que le forum offre la possibilité de lien entre les fil de discussion, n’hésitez pas à les utiliser (une rubrique est consacrée à l’usage technique du forum). En effet il se peut qu’une solution trouvée pour vous (ou quelqu’un d’autre), engendre quelques semaines plus tard une nouvelle question pour un développement complémentaire… Dans ce cas rédigez un nouveau Post en mettant un hyperlien sur le sujet initial, cela aidera grandement tous les participants à vous répondre.
 
M

Mytå

Guest
Bonsoir le forum

Ouf pesant sont code deja a simplifier un peu genre

Sub Save2()
Sheets("Modele").Activate
For Each cellule In Range("B5,E5,H5,B7,E7,H7,E11,H11,K15,F19,E23,D28")
If cellule = "" Then
reponse = MsgBox("Attention veuillez entrer une donné en " & cellule.Address & "", vbCritical)
Exit Sub
End If
Next cellule
Position = Sheets("Tableau").Range("A65536").End(xlUp).Row + 1
i = 1
For Each cellule In Sheets("Modele").Range("B5,E5,H5:H6,B7,E7,H7,E11,H11,A40,K15,D28,F29:F47")
Sheets("Tableau").Cells(Position, i).Value = cellule.Value
i = i + 1
Next cellule
Sheets("Tableau").Select
Range("A3:ae65536").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Sheets("Modele").Select
Range("a1").Select

'... reste a voir si la feuille existe deja

End Sub

Le message d'erreur vient du fait que si la feuille existe deja je pense

A suivre
smiley_417.gif
 
D

Domi

Guest
Bonjouur !!

Tou dabord désolé ZON de ne pas avoir répondu sur le forum et de ne pas avoir respecté le FIL !!!

Pour répondre à ZON mon premier probleme a été résolu grace a toi... g appliqué ce que tu mas di et tou é rentré dan lordre sof en ce qui concerne lalégement du code je ne mi sui pa risqué car je débute dan VBA.

Mon deuxième probleme c que g donc créé plusieurs fiches et arrivé à 28 fiches g le message derreur suivant

"Excel ne pe terminer cette tache avec les resources disponibles. Selectionnez mopin de données ou fermez des applications"

Je ne pe donc plu créé de fiche supplémentaires !!

aprés vérification la feuille a créé nexiste pas elle é bien différente de celle créé ! je supprime une feuille et je cré a nouvo une nouvelle et ca marche impecable le probleme vien dailleur mais d'ou ????


Merci déja pour vos réponses et éxcusé encore......
 
Z

Zon

Guest
Bonjour Domi et à tous,


Tu es pardonné(e), tu peux te servir ou pas du code Mytâ pour ce que tu veux faire, par contre pour le nombre de fiches ce n'est pas normal, il nous faudrait le code que tu utilises pour copier tes feuilles afin de l'alléger et voir si qqch ne cloche pas (penser à vider le presse papier par exemple

En effet il n'y a pas de limites dans le nombre de feuilles sous excel si ce n'est les ressources de l'ordinateur...



A+++
 
A

A_binouze_drinker_among_others

Guest
suggestion pour la 1° boucle de myta

For Each cellule In Range("B5,E5,H5,B7,E7,H7,E11,H11,K15,F19,E23,D28")
If cellule = "" Then reponse = IIf(reponse = "", cellule.Address, reponse & vbCr & cellule.Address)
Next cellule

If reponse <> "" Then x = MsgBox("Attention veuillez entrer une donné en :" & vbCr & reponse, vbCritical)
 
Z

Zon

Guest
Re,

Désolé Domi, j'avais mal lu, question bête est-ce que tu changes bien ta valeur E11 avant d'enregistrer à chaque fois car c'est elle qui renomme ta feuille ???

Rajoute la ligne suivante de code afin de vider le presse papier

If creation = vbOK Then modèle.Copy After:=modèle
application.cutcopymode =false
ActiveSheet.Name = Range("e11")

A+++
 

Discussions similaires

  • Question
Microsoft 365 Code VBA
Réponses
2
Affichages
308

Statistiques des forums

Discussions
312 083
Messages
2 085 183
Membres
102 808
dernier inscrit
guo