renommer onglet à partir d'une liste

[theocyt]

Bonjour,

Je souhaite faire un questionnaire que je vais envoyer en pièce jointe par mail.

J'ai un onglet avec la liste des personnes 'nom : liste utilisateur'
colonne 1 = utilisateur01---utilisateur75
colonne 2 = mail
colonne 3 = nom + prénom

J'ai le questionnaire sur un onglet 'nom : utilisateur FR'
J'ai le même questionnaire traduit en anglais 'nom : utilisateur GB'

Je voudrais créer une macro me permettant de copier les onglet utilisateur FR et utilisateur GB dans un nouveau fichier excel qui serait enregistré dans un dossier précis sur mon pc.

Le fichier et les onglets devraient etre renommé :
fichier : nom prénom.xls soit (colonne 3) de l'onglet liste utilisateur
utilisateur FR = nom prénom FR
utilisateur GB = nom prénom GB



pour le moment je me suis occupé de tester ma macro sur l'onglet FR en tentant de le dupliquer et le renommer ! mais j'échoue !





voilà ce que j'ai fait :

Sub CreationOnglettest()

ActiveCell.CurrentRegion.Select
Dim tableau() As String
ReDim tableau(1 To ActiveCell.CurrentRegion.Count)

For ctr = 1 To ActiveCell.CurrentRegion.Count
tableau(ctr) = ActiveCell.CurrentRegion(ctr)
Next

For I = 1 To ActiveCell.CurrentRegion.Count
Sheets(Array('Utilisateur FR')).Select
Sheets('Utilisateur FR').Activate
Sheets(Array('Utilisateur FR')).Copy.Name = tableau(ctr)
Next
'
End Sub


j'ai mis en fichier attaché la strucure de mon fichier

 

[MichelXld]

bonjour

j'espere que cet exemple pourra t'aider

Sub creationQuestionnaire_et_EnvoiMail()
Dim Cell As Range
Dim Wb As Workbook
Dim nomFichier As String
'------------
'necessite d'activer la reference Microsoft Outlook xx.x Object Library
'dans l'editeur de macros
'menu Outils
'references
'coches la ligne :'Microsoft Outlook xx.x Object Library'
'cliques sur OK pour valider
Dim Ol As New Outlook.Application
Dim olMail As MailItem


Application.ScreenUpdating = False

'creation du support pour les classeurs questionnaires
Sheets(Array('utilisateur FR', 'utilisateur GB')).Copy
Set Wb = ActiveWorkbook

'boucle sur les cellules de la colonne C dans la feuille 'liste utilisateur'
For Each Cell In ThisWorkbook.Sheets('liste utilisateur').Range('C2:C' _
& ThisWorkbook.Sheets('liste utilisateur').Range('C65536').End(xlUp).Row)

'adapter l'index des feuilles Sheets(1) et Sheets(2)
'en fonction de la position des noms d'onglet dans le classeur
With Wb
.Sheets(1).Name = Cell & ' FR'
.Sheets(2).Name = Cell & ' GB'
End With

nomFichier = 'C:\\' & Cell & '.xls'

'copie de sauvegarde des classeurs questionnaire
Wb.SaveCopyAs nomFichier

'-------- envoi mail ---------------------------
Set Ol = New Outlook.Application
Set olMail = Ol.CreateItem(olMailItem)

With olMail
.To = Cell.Offset(0, -1) 'recupere l'adresse mail dans la colonne B
.Subject = 'le questionnaire'
.Body = 'Bonjour ,' & vbLf & vbLf & 'Comme convenu , vous trouverez le questionnaire ' & _
'à remettre pour le 30/10/2005 au plus tard .' & vbLf & vbLf & 'Cordialement' & vbLf & 'mimi'

.Attachments.Add nomFichier 'pour joindre les classeurs questionnaires au message
.Send 'envoi message
End With

DoEvents
Kill nomFichier 'suppression des classeurs questionnaires apres l'envoi
Next

'fermeture sans sauvegarde du classeur qui a servi à creer les questionnaires
Wb.Close False
Application.ScreenUpdating = True
End Sub

bonne journée
MichelXld

Message édité par: michelxld, à: 30/09/2005 07:45