Amélioration d'une macro

topo

XLDnaute Junior
Bnjour à tous !

Toujours dans ma recherche de Macro-isation de mon mode de travail, je voudrais améliorer une macro:
Cette macro duplique un fichier excel en fonction d'une liste et lui donne le nom que je souhaite : (date + nom sur liste)

PHP:
Sub duplicata()

derlig = Range("a65536").End(xlUp).Row
For i = 1 To derlig
chemin = ActiveWorkbook.Path
If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
nomfich = ("31-03-09") & "_" & Cells(i, 1).Value & ".xls"

ActiveWorkbook.SaveAs Filename:=chemin & nomfich
Next

End Sub

Avant d'enregistrer, je voudrais faire une autre modificication dans le fichier Excel : copier le nom sur la liste dans une cellule dans un autre onglet.
Je voulais faire ça :

PHP:
Range(Cells(i,1)).select
selection.copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("autres").Select
selection.paste

mais cela ne fonctionne pas.

Merci de votre aide
 

JNP

XLDnaute Barbatruc
Re : Amélioration d'une macro

Bonjour Topo :),
Ne peux-tu pas simplement utiliser ?
Code:
Sheets("Feuil1").Cells(i, 1).Copy (Sheets("autres").Range("A1"))
Feuil1 est a remplacer par ta feuille d'origine. Ton défilement d'onglet ne sert à rien, et le Paste non plus.
Bonne journée :cool:
 

topo

XLDnaute Junior
Re : Amélioration d'une macro

Effectivement, c'est beaucoup plus simple !!!!!! Merci beaucoup JNP

Petite Question Bonus, Est-il possible, via la même macro de remplacer toutes les valeurs X de la feuille "autres" par la valeur copiée.
j'ai cette macro mais je ne sais pas comment la terminer :
PHP:
      Dim MotRech As String, MotRempl As String
      MotRech = "X"
      MotRempl = Range('A1').Value
     'Remplacer le mot dans chaque cellule de la feuille
???? => replace workbook?

Merci beaucoup
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : Amélioration d'une macro

Bonjour Topo, JNP

regarde le code ci-dessous, si cela peut t'aider :

Code:
Sheets("autres").Cells.Replace "X", Range("A1").Value, xlWhole, , False

remplace x dans la feuille "autres" par la valeur contenue dans la cellule A1 de la feuille active.

bon après midi
@+
 

topo

XLDnaute Junior
Re : Amélioration d'une macro

Bonjour Pierrot93,

le code ne fonctionne pas, je ne sais pas ce qu'il fait, mais il a aucune incidence sur le fichier Excel.

Mon "X" se trouve dans des liaisons:ie : la cellule F6 = c:\mes docs\fichiers\X-date.xls
peut-être que ça joue, je ne sais pas ...

Merci beaucoup
 

Pierrot93

XLDnaute Barbatruc
Re : Amélioration d'une macro

Re

oui c'est plus la même chose, si dans une formule, essaye peut être ainsi alors, plage de données à adapter :

Code:
Sub test()
Dim c As Range
For Each c In Sheets("autres").Range("a1:a100")
    c.FormulaLocal = Replace(c.FormulaLocal, "x", Sheets("autres").Range("C1").Value)
Next c
End Sub

bonne soirée
@+
 

topo

XLDnaute Junior
Re : Amélioration d'une macro

Bonjour,

J'ai essayé de grouper les deux macros, mais j'ai un problème dans l'ordre de création:
il me crée le fichier, me copie colle la cellule demandé, mais il ne remplace pas "deutschland" par la cellule demandée; il ne le fait que la première fois ...

ex: j'ai trois fichiers à changer : China, Czech, US
dans ma liste, il a ses trois noms (sur deux colonnes car j'en ai besoin de deux)
je lance la macro, elle me rentre correctement les noms des fichiers 31-03-09_China, elle copie colle china en 'P & L\A3' et elle me remplace les deutschland par China. Ok parfait.
Pour Czech et US, elle va uniquement me faire bien les deux premières étapes, mais elle va me changer deutschland par China et pas par Czech ou Us comme je lui ai normalement demandé (enfin je pense).
Que dois-je modifier?

PHP:
Sub duplicata()

derlig = Range("a65536").End(xlUp).Row
For i = 1 To derlig
chemin = ActiveWorkbook.Path
If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
nomfich = ("31-03-09") & "_" & Cells(i, 1).Value & ".xls"

Sheets("Datas").Cells(i, 2).Copy (Sheets("P & L").Range("A3"))

Dim c As Range
For Each c In Sheets("P & L").Range("I6:M170")
    c.FormulaLocal = Replace(c.FormulaLocal, "deutschland", Sheets("P & L").Range("A3").Value)
Next c

Dim b As Range
For Each b In Sheets("B & S").Range("E4:E55,E70,E72:E123")
    b.FormulaLocal = Replace(b.FormulaLocal, "deutschland", Sheets("P & L").Range("A3").Value)
Next b

ActiveWorkbook.SaveAs Filename:=chemin & nomfich

Next

End Sub

Merci

PS, j'ai essayé de changer le next de place, mais cela ne fait qu'inversé le problème.
 

Discussions similaires

Réponses
7
Affichages
367

Statistiques des forums

Discussions
312 684
Messages
2 090 918
Membres
104 699
dernier inscrit
Azyra