Exportation et adaptation de macros

macmag

XLDnaute Nouveau
Bonjour,

J'ai 2 fichiers excel dont l'un comporte des macros. J'ai pour habitude d'ouvrir les 2 en simultanée, de façon à pouvoir exécuter les macros sur l'un comme sur l'autre. Mais la macro suivante ne s'exécute pas sur le 2ème fichier :

Sub CreationFichier()
Dim n&, chemin$, w As Worksheet, t$, Wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier existe déjà
n = Application.SheetsInNewWorkbook 'nombre de feuilles des nouveaux classeurs
Application.SheetsInNewWorkbook = 1
chemin = ThisWorkbook.Path & "\" 'chemin d'accès à adapter
For Each w In Worksheets
t = Mid(w.[C3].Formula, 2)
On Error Resume Next
t = Range(t).Address
If Err = 0 Then
Set Wb = Workbooks.Add 'nouveau document
w.Cells.Copy Wb.Sheets(1).Cells 'copie de la feuille
Wb.Sheets(1).UsedRange = Wb.Sheets(1).UsedRange.Value 'supprime les formules (facultatif)
Wb.Sheets(1).Name = w.Name 'renomme la feuille du nouveau document
Wb.SaveAs chemin & Epure(w.Name) 'crée le fichier sur le disque dur
Wb.Close
End If
Next

je joins le fichier.

Ma 2ème requête : je voudrais que les macros apparaissent sur le 2ème fichier sans que j'ai besoin d'ouvrir le 1er

Merci d'avance pour votre aide
 

Pièces jointes

  • NEW planning prévi test.xlsm
    72 KB · Affichages: 44

job75

XLDnaute Barbatruc
Re : Exportation et adaptation de macros

Bonsoir macmag,

Je vous avais donné ce code le 31/07/2011 mais vous ne l'avez pas copié intégralement :

Code:
Sub CreationFichier()
 Dim n&, chemin$, w As Worksheet, t$, Wb As Workbook
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False 'si un fichier existe déjà
 n = Application.SheetsInNewWorkbook 'nombre de feuilles des nouveaux classeurs
 Application.SheetsInNewWorkbook = 1
 chemin = ThisWorkbook.Path & "\" 'chemin d'accès à adapter
 For Each w In Worksheets
   t = Mid(w.[C3].Formula, 2)
   On Error Resume Next
   t = Range(t).Address
   If Err = 0 Then
     Set Wb = Workbooks.Add 'nouveau document
     w.Cells.Copy Wb.Sheets(1).Cells 'copie de la feuille
     Wb.Sheets(1).UsedRange = Wb.Sheets(1).UsedRange.Value 'supprime les formules (facultatif)
     Wb.Sheets(1).Name = w.Name 'renomme la feuille du nouveau document
     Wb.SaveAs chemin & Epure(w.Name) 'crée le fichier sur le disque dur
     Wb.Close
   End If
 Next
 Application.SheetsInNewWorkbook = n
 End Sub
 
Function Epure$(t$)
 Dim interdit$, i As Byte
 interdit = ":""/\<>?*[]|" 'caractères interdits dans les noms des feuilles OU des classeurs
 For i = 1 To 11
   t = Replace(t, Mid(interdit, i, 1), "#")
 Next
 Epure = t
 End Function
Pas le temps d'étudier votre problème ce soir.

Bonne nuit à tous.
 

job75

XLDnaute Barbatruc
Re : Exportation et adaptation de macros

Bonjour macmag, le forum,

S'il y a plusieurs classeurs ouverts il faut préciser le classeur qui est traité.

Avec ceci ce sera toujours le classeur actif :

For Each w In ActiveWorkbook.Worksheets

Pour la 2ème question vous pouvez mettre cette macro dans un fichier .xla (macro complémentaire).

C'est un fichier masqué que vous pouvez faire ouvrir au démarrage d'Excel, cherchez sur le web ou le forum l'endroit où il faut le placer.

Ainsi la macro sera toujours diponible.

A+
 

job75

XLDnaute Barbatruc
Re : Exportation et adaptation de macros

Re,

Ah j'oubliais, sur Excel 2007/2010 il faut préciser le format du fichier créé.

Donc remplacer :

Code:
Wb.SaveAs chemin & Epure(w.Name)
par :

Code:
Wb.SaveAs chemin & Epure(w.Name), IIf(w.Rows.Count > 65536, 51, 1)
A+
 

Discussions similaires

Statistiques des forums

Discussions
312 913
Messages
2 093 534
Membres
105 750
dernier inscrit
fred13340