Copier, renommer feuille VBA + Liste déroulante

[Résolu/Fermé]
Signaler
Messages postés
2
Date d'inscription
mardi 30 août 2016
Statut
Membre
Dernière intervention
31 août 2016
-
Messages postés
2
Date d'inscription
mardi 30 août 2016
Statut
Membre
Dernière intervention
31 août 2016
-
Bonjour,


Je suis en pleine construction d'un gros fichier important de gestion de contrat scientifique (comportant entre du VBA, et plein de formules que je n'ai pas encore complété)

Depuis un moment je bute sur 2 soucis :

-liste en cascade et je n'arrive pas à voir l'erreur, le message est le suivant : "la source est reconnue comme erronée" : la liste déroulante se situe dans la feuille "FICHE CONTRAT", la première "Type de Projet" est en B13 qui génère alors la deuxième liste "Sous Catégorie" en E13. Tous les éléments de ces listes se situent dans la feuille "Feuil1" : Type de Projet : A2:A25, - Sous Catégorie : B2:B25

-L'onglet "FICHE CONTRAT" est un onglet type que je veux copier dans le même classeur tout en le renommant en fonction du nom que j'aurai saisi en "B7"

Voici mon code :

    'on copie FICHE CONTRAT
Sub CopierEtRenommerFeuille()
Dim Sh As Worksheet, Ws As Worksheet
Set Ws = ActiveSheet
Set Sh = Worksheets.Add(AFTER:=Sheets(Sheets.Count))
Ws.Cells.Copy
With Sh.Range("A1")
.PasteSpecial xlPasteAll
.Range("A1").Select
End With

End Sub



J'ai vu un tas de sujets sur le site et le web que j'ai essayé d'appliquer, mais rien à faire je n'y arrive pas :s

S'il vous plait aidez moi

Merci par avance

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

1 réponse

Messages postés
16527
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 octobre 2021
3 232
bonjour

pour créer une fiche contrat avec acronyme inscrit

Option Explicit
'-------------------------------
Sub créer_nouveau()
Dim Onglet As String
Onglet = Sheets("fiche contrat").Range("B7")
If Onglet = "" Then Exit Sub
Sheets("fiche contrat").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Onglet
End Sub


et EVENTUELLEMENT pour ne pas recommencer worksheet_activate
Private Sub Worksheet_Activate()
If ActiveSheet.Name <> "fiche contrat" Then Exit Sub
' Message Avertissement
MsgBox "Merci de Remplir les informations o

a écrire dans le modele fiche contrat
Messages postés
2
Date d'inscription
mardi 30 août 2016
Statut
Membre
Dernière intervention
31 août 2016

Merci c'est parfait :)