Recopie d'onglets via VBA

Bonjour, j'ai élaboré une macro pour recopier des onglets qui sont différents entre eux. Mais je ne suis pas très satisfait car au bout de la 2ème copie, j'ai un message d'erreur soit "400" ou sinon le nom de l'onglet n'est pas le bon.

Je m'explique, quand on est par exemple sur l'onglet pneus et que l'on clique sur "créer une nouvelle feuille" et bien j'ai bien un nouvel onglet s'appelant "Pneus_1_NICE OUEST" est-il possible que cette feuille s'appelle "Pneus_date du jour". Car il n'y aura pas plus d'un onglet créer par semaine. Si pas possible, je laisserai comme cela.

Par contre, lorsque je suis sur cet onglet"Pneus_1_NICE OUEST" et que je clique sur "créer une nouvelle feuille" et bien j'ai un message d'erreur "'400" mais j'ai quand même un nouvel onglet s'appelant "Pneus_1_NICE OUEST (2)" si avec la date du jour ce n'est pas possible, est-ce que ce dernier pourrai s'appeler "Pneus_2_NICE OUEST"

Et également, si je créer un 2ème onglet, mais cette fois pas à partir de "Pneus_1_NICE OUEST" mais de l'onglet "Pneus" et bien j'ai toujours mon message d'erreur "400" et cette fois le nouvel onglet s'appelle "Pneus (2)" et non "Pneus_2_NICE OUEST"

J'ai déjà fait beaucoup de recherche, et je n'arrive pas à résoudre mon problème, si quelqu'un pouvait m'aider

Merci

https://www.cjoint.com/c/HAerjVuka0u

Bonjour,

Pour le nom avec la date du jour :

ActiveSheet.Name = "Pneus_" & Replace(Date, "/", "-")

Pour incrémenter le chiffre du milieu de nom ("Pneus_1_NICE OUEST" en "Pneus_2"_NICE OUEST, Pneus_3_NICE OUEST, etc...) c'est un peu plus compliqué, il faut boucler sur le nom des feuilles afin de récupérer la valeur max et l'incrémenter de 1 :

Sub CopycartouchesSheetRename()

    Dim Fe As Worksheet
    Dim Nom As String
    Dim I As Integer
    Dim Max As Integer

    If MsgBox("Etes vous certain(e) de vouloir dupliquer cette feuille ?", vbYesNo + vbInformation, _
        "Demande de confirmation PNEUS") = vbYes Then

        For Each Fe In Worksheets

            If InStr(Fe.Name, "Pneus_") > 0 Then If Split(Fe.Name, "_")(1) > Max Then Max = Split(Fe.Name, "_")(1)

        Next Fe

        ActiveSheet.Copy Before:=Worksheets("Pneus")

        ActiveSheet.Name = "Pneus_" & Max + 1 & "_" & Sheets("Pneus").Range("F18").Value

    Else

        Sheets("Pneus").Range("A1").Select
        MsgBox "Opération annulée par l'utilisateur"

    End If

End Sub

Pour la 2ème solutions cela fonctionne parfaitement, par contre pour la date j'ai un message d'erreur. Cependant est-il possible de légèrement modifier le nom de l'onglet par "Pneus_yyyymmaa" avec la date du jour lorsque l'on clique sur créer une nouvelle feuille. Car il n'y aura jamais 2 feuilles crées le même jour.

Encore merci et super boulot.

Re,

...Cependant est-il possible de légèrement modifier le nom de l'onglet par "Pneus_yyyymmaa" avec la date du jour...

Avec ceci :

ActiveSheet.Name = "Pneus_" & Format(Date, "yyyymmdd")

J'ai remplacer le code ActiveSheet.Name = "Pneus_" & Max + 1 & "_" & Sheets("Pneus").Range("F18").Value par celui que tu viens de me donner ActiveSheet.Name = "Pneus_" & Format(Date, "yyyymmdd"), mais j'ai toujours un message d'erreur

Regardes dans le menu "Outils" --> "Référence" et décoches toutes les références marquées MANQUANT

Désolé, mais dans le menu "outils" je n'ai pas "Référence"

Bonjour,

C'est dans le menu "Outils" du VBE et "Références..." est le premier !

Encore merci pour l'aide, c'est au top, les 2 fonctionnent impeccablement.

Par contre j'aimerais savoir, comment ce fait-il que chez moi sous mac impossible d'avoir le menu outils et Références, alors que ce matin au bureau sous PC cela fonctionne nickel.

Encore bravo.

Je ne peux pas te dire, je n'ai pas Excel Mac !

Est-ce que je peux encore poser une question.

J'ai un onglet, que je ne vais utiliser qu'une seule fois dans la semaine, est-il possible quand on créer le nouvelle onglet, que ce dernier s'appelle par exemple "Pneus_numéro de semaine"

Merci

Re,

Une fonction à mettre dans le module standard :

Function NumSem(LaDate As Date) As Integer

    NumSem = Int((LaDate - DateSerial(Year(LaDate - Weekday(LaDate - 1) + 4), 1, 1) _
             + Weekday(DateSerial(Year(LaDate - Weekday(LaDate - 1) + 4), 1, 1)) + 5) / 7)

End Function

puis à appeler de la façon suivante :

ActiveSheet.Name = "Pneus_" & NumSem(Date) 'Date = date du jour

Bonjour, ou faut-il que je place cette ensemble dans le module standard

Sub Mail()

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim S As Shape

Dim sNomFic As String, sRep As String, WshShell As Object

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

' Créer une instance Windows Script pour retrouver le chemin du bureau

Set WshShell = CreateObject("WScript.Shell")

sRep = WshShell.SpecialFolders("Desktop")

Set WshShell = Nothing

' D_finit le nom du fichier ö enregistrer

sNomFic = "Registre de sortie des déchets" & Format(Date, "yyyymmdd") & ".pdf"

' Enregistrer la feuille en PDF

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _

Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Set OutApp = CreateObject("outlook.application")

Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = "christophe.corvisier@nicecotedazur.org"

.CC = "robert.peters@nicecotedazur.org;sebastien.reynaud@nicecotedazur.org;denis.dibenedetto@nicecotedazur.org;christophe.corvisier@nicecotedazur.org"

.Attachments.Add (sRep & "\" & sNomFic)

.Subject = "Registre de sortie des déchets de Nice Ouest"""

.Body = "Nice, le " & Format(Date, "dd/mm/yy") & vbCrLf & vbCrLf

.Body = .Body & "Bonjour Gilles," & vbCrLf

.Body = .Body & "Objet : Registre de sortie des déchets de Nice Ouest" & vbCrLf & vbCrLf

.Body = .Body & "Tu trouveras ci-joint le registre de sortie des déchets sur Nice Ouest " & vbCrLf & vbCrLff

.Body = .Body & "Salutations cordiales" & vbCrLf

.Display

.Send 'envoi automatique

End With

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

Kill (sRep & "\" & sNomFic)

End Sub

Je suis désolé, je me suis trompé de code

Option Explicit

Sub CopycartouchesSheetRename()

Dim Fe As Worksheet

Dim Nom As String

Dim I As Integer

Dim Max As Integer

If MsgBox("Etes vous certain(e) de vouloir dupliquer cette feuille ?", vbYesNo + vbInformation, _

"Demande de confirmation REGISTRE") = vbYes Then

For Each Fe In Worksheets

If InStr(Fe.Name, "Registre_") > 0 Then If Split(Fe.Name, "_")(1) > Max Then Max = Split(Fe.Name, "_")(1)

Next Fe

ActiveSheet.Copy Before:=Worksheets("Registre")

ActiveSheet.Name = "Registre_" & Format(Date, "yyyymmdd")

Else

Sheets("Registre").Range("A1").Select

MsgBox "Opération annulée par l'utilisateur"

End If

End Sub

Je ne vois pas ou mettre votre code

Re,

La fonction tu la mets dans un module standard et la ligne de code qui fait appel à cette dernière tu la mets dans ta sub là où tu veux nommer ta feuille

C'est bon concernant la numéro de semaine cela semble fonctionner.

Par contre il y a encore un soucis, hier j'ai créer une nouvelle feuille par exemple "Huilesveg_20180105" et aujourd'hui lorsque je clique sur "créer une nouvelle feuille" pour que cette dernière ce nomme "Huilesveg_20180106", et bien j'ai un message d'erreur "Dépacement de Capacité" (cf photo ci-jointe)

Merci

Voici le fichier joint si besoin, car je ne vois vraiment pas d'ou peu venir l'erreur, concernant ce dépassement de capacité.

https://www.cjoint.com/c/HAhjlEHxaOu

Bonjour,

C'est normal, tu utilises ces lignes de code à mauvais escient pour un nom de type "Huilesveg_20180107" :

For Each Fe In Worksheets

    If InStr(Fe.Name, "Huilesveg_") > 0 Then If Split(Fe.Name, "_")(1) > Max Then Max = Split(Fe.Name, "_")(1)

Next Fe

comme je te l'ai dis dans un précédent post :

Pour incrémenter le chiffre du milieu de nom ("Pneus_1_NICE OUEST" en "Pneus_2"_NICE OUEST, Pneus_3_NICE OUEST, etc...) c'est un peu plus compliqué, il faut boucler sur le nom des feuilles afin de récupérer la valeur max et l'incrémenter de 1 :

c'est pour un nom de type "Pneus_1_NICE OUEST"

La variable Max est déclarée Integer (entier) et sa limite est de 32 767 donc, une valeur de 20 180 107 (extraite de la chaîne "Huilesveg_20180107" pour le le 07/01/2018) est bien trop grande ce qui entraîne un dépassement de capacité !

Remplace la Sub "CopycartouchesSheetRename" par celle-ci :

Sub CopycartouchesSheetRename()

    Dim Fe As Worksheet
    Dim Nom As String
    Dim I As Integer
    Dim Max As Integer

    If MsgBox("Etes vous certain(e) de vouloir dupliquer cette feuille ?", vbYesNo + vbInformation, _
        "Demande de confirmation HUILES VEGETALES") = vbYes Then

        On Error Resume Next
        Set Fe = Worksheets("Huilesveg_" & Format(Date, "yyyymmdd"))

        If Err.Number <> 0 Then

            ActiveSheet.Copy Before:=Worksheets("Huilesveg")
            ActiveSheet.Name = "Huilesveg_" & Format(Date, "yyyymmdd")

        Else

            MsgBox "La feuille " & "Huilesveg_" & Format(Date, "yyyymmdd") & " existe déjà !": Exit Sub

        End If

    Else

        Sheets("Huilesveg").Range("A1").Select
        MsgBox "Opération annulée par l'utilisateur"

    End If

End Sub

Encore, merci à toi, les tests ont été concluant

J'aimerais dans le corps de message intégrer un texte avec des accents et de la ponctuation, actuellement je n'y arrive pas car à chaque fois que je met un accent il enlève la lettre, donc dans la macro email, j'ai enlever tous les accents et les ponctuations.

Mais j'aimerais vraiment pouvoir intégrer dans mon corps de message un texte de ce type :

Madame bonjour,

Par la présente et conformément au décret n° 2012-1538 du 28 décembre 2012, complété par le décret du 24 juin 2016 clarifiant la collecte gratuite en déchetterie des bouteilles hors consigne, je vous prie de bien vouloir trouver ci-joint, une nouvelle demande d’enlèvement de bouteilles de gaz de votre marque sur la déchetterie de Nice Est, sise angle Boulevard Jean Baptiste VERANY – Rue Georges CHAPEL.

Cette déchetterie reçoit beaucoup de flux de déchets et notamment de bouteilles de gaz qui arrivent aussi par l’intermédiaire des différents services de collecte (elles sont récupérées sur la voie publique), je vous demande de bien vouloir intervenir afin de les récupérer.

Je vous demande de faire collecter le reliquat de bouteilles qui pourrait être arrivé entre cette demande et votre intervention.

Merci de bien vouloir me confirmer une date de passage afin que nous puissions nous organiser.

Bien cordialement

Merci pour l'aide