Macro nommer onglet selon liste (mot composé)

[VBA]

Bonjour à tous,



J'ai la macro ci-jointe (que Stéphane du forum m'a aidé à monter - encore merci) et elle doit créer onglet reprenant le terme "somme" de lafeuille source "sommes" et y ajouter un nom extrait d'une liste située ds la "feuil3".

Mais la macro ne veut pas créer les onglets suivant le nom composé que j'ai défini (feuille "somme"&nms). Elle créé juste les feuilles en les numérotant.

Je n'arrive pas à trouver de solution.

Si quelqu'un peut m'aider ce serait super.

Merci


voir texte macro ci-après :





Sub test()

On Error Resume Next 'continue l'execution en cas d'erreur.
Application.DisplayAlerts = False 'desactive les alertes d'Excel.
Application.ScreenUpdating = False 'desactive le rafraechissement de l 'ecran.
Dim nmS As String, nmB As String 'variables pour les noms des feuilles.
Set wsh_somme = Worksheets("somme") 'feuille memorisee dans une variable objet.
Set wsh_bilan = Worksheets("bilan") 'feuille memorisee dans une variable objet.
Set wsh_data = Worksheets("Feuil3") 'feuille memorisee dans une variable objet.

For i = 2 To wsh_data.[A65536].End(xlUp).Row 'de la 2nde cellule de la fin de la colonne.
nm = wsh_data.Cells(i, 1) 'nom de la personne concernee.
nmS = "somme " & nm 'creation du nom d'une feuille somme.
nmB = "bilan " & nm 'creation du nom d'une feuille bilan.

'si la feuille existe, rien n'est fait, sinon la feuille est cree en dern.Position

If Not SheetExists(ThisWorkbook.Name, nmS) Then
wsh_somme.Copy after:=Sheets(Sheets.Count)

Else


'renommage de la feuille cree, elle est supprimee si une erreur surgit.
If SheetExists(ThisWorkbook.Name, "somme " & nm) Then
ActiveSheet.Name = nmS: [A1] = "somme " & nm

End If
End If


If Not SheetExists(ThisWorkbook.Name, nmB) Then
wsh_bilan.Copy after:=Sheets(Sheets.Count)

Else

If SheetExists(ThisWorkbook.Name, "bilan " & nm) Then
ActiveSheet.Name = nmB: [A1] = "bilan " & nm

End If

End If

Next i

End Sub

'################
'# verifie qu'un onglet existe dans un classeur
'# usage : If SheetExists(strSheetName) Then ...

Public Function SheetExists(ByVal strBookName As String, ByVal strSheetName As String) As Boolean
Dim strTemp As String

On Error GoTo Problem
strTemp = Workbooks(strBookName).Sheets(strSheetName).Name
SheetExists = True
Exit Function
Problem:
SheetExists = False
End Function



vba

 

[sousou]

Bonjour VBA

Voici le début de ton code simplifié
J'ai pas tout compris la manière ton tu voulais que cela fonctionne !

Sub test()

On Error Resume Next 'continue l'execution en cas d'erreur.
Application.DisplayAlerts = False 'desactive les alertes d'Excel.
Application.ScreenUpdating = False 'desactive le rafraechissement de l 'ecran.
Dim nmS As String, nmB As String 'variables pour les noms des feuilles.
Set wsh_somme = Worksheets("somme") 'feuille memorisee dans une variable objet.
Set wsh_bilan = Worksheets("bilan") 'feuille memorisee dans une variable objet.
Set wsh_data = Worksheets("Feuil3") 'feuille memorisee dans une variable objet.

For i = 2 To wsh_data.[A65536].End(xlUp).Row 'de la 2nde cellule de la fin de la colonne.
nm = wsh_data.Cells(i, 1) 'nom de la personne concernee.
nmS = "somme " & nm 'creation du nom d'une feuille somme.
nmB = "bilan " & nm 'creation du nom d'une feuille bilan.

'si la feuille existe, rien n'est fait, sinon la feuille est cree en dern.Position

If Not SheetExists(ThisWorkbook.Name, nmS) Then
wsh_somme.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = nmS
End If


If Not SheetExists(ThisWorkbook.Name, nmB) Then
wsh_bilan.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = nmB

End If
Next i

End Sub