onglet avec macro(rectificatif)

Re : onglet avec macro(rectificatif)

Bonsoir

Option Explicit
Sub creation()
Dim Sh As Worksheet
Dim i As Integer
Dim j As Integer
Dim nu() As String

Il faut mettre le code ici , pour éviter la création


For Each Sh In Worksheets
............................................

JP

Re : onglet avec macro(rectificatif)

Bonsoir,
Comment,je fais pour ajouter 2 cellules supplémentaires dans la détection "si vide"
J'ai voulu copier le code,mais ce n'est pas aussi simple.
Encore bravo,et merci.

Re : onglet avec macro(rectificatif)

Bonjour

En recopiant le code envoyé, et en indiquant les coordonnées de la cellule.
Si nécessaire modifier le message pour donner plus d'information.

JP

Re : onglet avec macro(rectificatif)

Bonjour,
voici,comment je place le code;mais il apparraît l'erreur suivante:erreur de compilation,"end with sans with"

Dim nu() As String
With Sheets("modéle")
If .Range("C11").Value = "" Then
Call MsgBox("Vous dever renseigner la cellule", vbInformation, Application.Name)
.Range("C11").Select
If .Range("D14").Value = "" Then
Call MsgBox("Vous devez renseigner la cellule", vbInformation, Application.Name)
.Range("D14").Select
Exit Sub
End If
End With

merci.@+laplayast

Re : onglet avec macro(rectificatif)

Bonjour

laplayast à dit:

Bonjour,
voici,comment je place le code;mais il apparraît l'erreur suivante:erreur de compilation,"end with sans with"

Dim nu() As String
With Sheets("modéle")
If .Range("C11").Value = "" Then
Call MsgBox("Vous dever renseigner la cellule", vbInformation, Application.Name)
.Range("C11").Select
Exit Sub
End If

If .Range("D14").Value = "" Then
Call MsgBox("Vous devez renseigner la cellule", vbInformation, Application.Name)
.Range("D14").Select
Exit Sub
End If
End With

merci.@+laplayast

Cliquez pour agrandir...

Avec ce type de message il manque simplement un end, qui peut être end if, end with,....

Il manque end if après .Range("C11").Select

JP

Re : onglet avec macro(rectificatif)

Salut laplayast, jp14🙂, le Forum

un End If mal placé

essaye ce code light et dis nous

Re : onglet avec macro(rectificatif)

Formidable,cela fonctionne correctement .Bravo!cela avance et merci.
Mais,il reste quelques ajustements:si au modèle1,je change une valeur,de la
cellule D14,ou H14;au modèle2 les valeurs sont bien prises en compte;mais les valeurs du modèle1,reviennent à l'etat de la création initiale;la modif disparait.
Cela,je suppose et du au fait de garder en mémoire,les résultats.Mais alors comment faire?Je doit changer les valeurs,parfois!
amicalement,LAPLAYAST@+

Le code tel qu'il est maintenant:
Option Explicit
Sub creation()
Dim Sh As Worksheet
Dim i As Integer
Dim j As Integer
Dim nu() As String
With Sheets("modéle")
If .Range("C11").Value = "" Then
Call MsgBox("Vous dever renseigner la cellule", vbInformation, Application.Name)
.Range("C11").Select
Exit Sub
End If
If .Range("D14").Value = "" Then
Call MsgBox("Vous devez renseigner la cellule", vbInformation, Application.Name)
.Range("D14").Select
Exit Sub
End If
End With
For Each Sh In Worksheets
If Sh.Name <> "modéle" Then
If InStr(Sh.Name, "modéle") > 0 Then
j = CInt(Replace(Sh.Name, "modéle", ""))
If j > i Then i = j
End If
End If
Next Sh
With Sheets("modéle")
.Copy after:=Sheets(Sheets.Count)
' On Error GoTo PbNomFeuille
ActiveSheet.Name = "modéle" & i + 1 '' référence"
End With
'
' on met les noms dans un tableau
ReDim nu(Sheets.Count)
For Each Sh In Worksheets
If Sh.Name <> "modéle" Then
If InStr(Sh.Name, "modéle") > 0 Then
j = CInt(Replace(Sh.Name, "modéle", ""))
nu(j) = Sh.Name
End If
End If
Next Sh
' on recopie les données de l'avant dernier dans le dernier
For j = UBound(nu) To LBound(nu) Step -1
If nu(j) <> "" Then
i = 1
If j > 1 Then
Do
If nu(j - i) <> "" Then Exit Do
i = i + 1
If i > Sheets.Count Then Exit Do ' sortie si problème
Loop

i = j - i
Call recopie(nu(i), nu(j))
Else
Call recopie("modéle", nu(j))
End If
End If
Next j
End Sub
Private Sub recopie(nomforig As String, nomfdest As String)
Dim £j As Integer
With Sheets(nomfdest)
'copier les cellules"H28 à H34 et I28 à I34,de la feuille modèle _
vers la feuille modèle1, vers les cellules "C28 à D34
For £j = 28 To 34
.Range("C" & £j).Value = Sheets(nomforig).Range("h" & £j).Value
.Range("D" & £j).Value = Sheets(nomforig).Range("i" & £j).Value
Next £j
' compléter pour les cellules roses
.Range("C11").Value = Sheets(nomforig).Range("C11").Value
.Range("D14").Value = Sheets(nomforig).Range("D14").Value
.Range("H14").Value = Sheets(nomforig).Range("H14").Value
.Range("I11").Value = Sheets(nomforig).Range("I11").Value
.Range("H36").Value = Sheets(nomforig).Range("D36").Value
End With
End Sub

Re : onglet avec macro(rectificatif)

Bonsoir,
Peut-être,avez vous une solution,à mon problème;car je ne vois pas comment me sortir,de cet affichage récalcitrant;au niveau des cellules.Voir,le post au dessus.
merci,de votre écoute.😉
@+laplayast

Re : onglet avec macro(rectificatif)

Bonsoir,
Peut-être,une solution à mon problème d'affichage;mais je ne vois,plus"DULL"et"JP14";
auriez-vous une idée.
merci.
laplayast@+

Re : onglet avec macro(rectificatif)

Bonjour

Ci dessous le fichier avec une solution a tester.

Pour modifier ouverture d'un userform.
Les anciennes données sont recopiées en l14 et h14.
Ces cellules sont testés lors du transfert de données.


JP

Re : onglet avec macro(rectificatif)

Bonsoir,
merci,de ta solution cela va parfaitement.
Je reprendrai, demain car la fin de journée fût difficile.
merci,encore de ton aide.
laplayast@+😉

Re : onglet avec macro(rectificatif)

Bonsoir,
je reviens, vers vous pour simplifier le code suivant servant à l'impression des
onglets.Ce code,n'imprime que les onglets qu'on lui demande avec les numeros correspondants.Je souhaiterai,garder la même plage pour les cellules,et selectionner les onglets en automatique.Si 10 onglets=10 impressions(1impression/onglet).
Merci,et amicalement,LAPLAYAST@+

Sub ImprimFiche()
Msg = "Voulez-vous vraiment imprimer TOUTES les fiches ?"
Style = vbYesNo + vbCritical + vbDefaultButton1
Title = "IMPRESSION DES FICHES"
Réponse = MsgBox(Msg, Style, Title)
If Réponse = vbYes Then
GoTo continu
Else
Exit Sub
End If
continu:
Dim mafeuille As Object
Application.ScreenUpdating = False
Set monTab = Worksheets(Array(5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, _
23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42))
For Each mafeuille In monTab
mafeuille.Select
ActiveSheet.PageSetup.PrintArea = "$B$1:$I$43"
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Next
End Sub