Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Copier des formules sur un ensemble de fichiers

charles2b

XLDnaute Nouveau
Bonjour,

j'ai un fichier de référence avec une trentaine de formules à appliquer à un ensemble de fichier. Je sais comment appliquer une macro à un ensemble de fichiers de la manière suivante :

Sub TEST()
Dim Fich As String
Const chemin = "C:\Documents and Settings\XX\Bureau\TEST MACRO MULTIPLE\A APPLIQUER\"
Fich = Dir(chemin & "*.xls")
Do While Fich <> ""
Workbooks.Open chemin & Fich
Call APPLI ----- la macro que je souhaite faire --------
Workbooks(Fich).Close True 'ou true si tu enregistres
Fich = Dir
Loop
End Sub



Mais comment créer cette macro APPLI qui me permettrait de ne pas avoir à recopier manuellement toute les formules des trente cellules.

j'avais l'idée d'appliquer : range ("[feuille1]feuill1!A1).Copy Range ("[......liste des fichiers] là je bloque sérieux !!

en fait je voudrais copier les cellules A1 juqu'à A30 par exemple à certains endroit d'un autre fichier de structure identique (EX: copier la cellule A1 du fichier 1 sur la cellule B3 des fichiers 2 à 200)

En espérant avoir été clair et surtout que quelqu'un puisse m'apporter de l'aide !
 

mth

XLDnaute Barbatruc
Re : Copier des formules sur un ensemble de fichiers

Bonjour Charles2b,

Un essai avec ce que j'ai compris,

Code:
Sub TEST()
Application.ScreenUpdating = False
Dim Fich As String, chemin As String
chemin = "C:\XXXX\TEST MACRO MULTIPLE\A APPLIQUER\"
Fich = Dir(chemin & "*.xls")
Do While Fich <> ""
    Workbooks.Open chemin & Fich
    ThisWorkbook.Sheets("Feuil1").Range("A1:A30").Copy
    Workbooks(Fich).Activate
    ActiveWorkbook.Sheets("Feuil1").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Workbooks(Fich).Close True
    Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub

Bonne journée,

mth
 

charles2b

XLDnaute Nouveau
Re : Copier des formules sur un ensemble de fichiers

Salut,

je viens de tester et après une légère modif ça marche du tonnerre. voici la ligne de code modifiée :

Sub TEST()
Dim Fich As String, chemin As String
Const chemin = "C:\XXXX\TEST MACRO MULTIPLE\A APPLIQUER\"
Fich = Dir(chemin & "*.xls")
Do While Fich <> ""
Workbooks.Open chemin & Fich
ThisWorkbook.Sheets("Feuil1").Range("A1:A30").Copy
Workbooks(Fich).Activate
ActiveWorkbook.Sheets("Feuil1").Select
Range("A1").Select
ActiveSheet.Paste

Workbooks(Fich).Close True
Fich = Dir
Loop
End Sub

Et voilà le travail

il persiste juste un petit problème :
certaines cellules copiées rapportent les formules avec leur liaisons du classeur initial ( '[classeur1]') et ça me fausse donc le résultat des fichiers de destination.
J'ai pensé à faire une macro où je repasse sur chaque cellule et supprime la liaison, mais n'y aurait il pas une solution plus simple à appliquer au cours le la 1ère macro ?

Déja un grand Merci tout de même car mon problème est bien résolu !
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…