Bonjour à tous
Encore une fois je solicite votre aide pour une loope dans macro(assez simple même si elle a l'air complexe)
La macro autrement dit remplace tout des 100 classeurs et plus (macro fond mise en page) par Model sauf la base(texte dans cell).
Le prob est comment faire une loope pour qu'elle ouvre tout les classeurs du dossier et remplace tout par model sauf la base?
Sub Remplace()
'Ouvre tout les fichiers du dossier...Mes documents
Workbooks.Open Filename:= _
'C:\\Documents and Settings\\Claude\\Mes documents\\1.xls'
Workbooks.Open Filename:= _
'C:\\Documents and Settings\\Claude\\Mes documents\\2.xls'
Workbooks.Open Filename:= _
'C:\\Documents and Settings\\Claude\\Mes documents\\Model.xls'
'-------------------------------------------------------------------
'Copie les valeurs de classeur 1.xls vers Model.xls
Windows('1.xls').Activate
Range('A1:A10').Select
Selection.Copy
Windows('Model.xls').Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Referme 1.xls
Windows('1.xls').Activate
ActiveWindow.Close
'Save as et remplace le 1.xls par Model.xls
ActiveWorkbook.SaveAs Filename:= _
'C:\\Documents and Settings\\Claude\\Mes documents\\1.xls', FileFormat:=xlNormal _
, Password:='', WriteResPassword:='', ReadOnlyRecommended:=False, _
CreateBackup:=False
'Fait la même chose pour le 2.xls
'Copie les valeurs de classeur 2.xls vers 1.xls ...(Ancien Model.xls)
Windows('2.xls').Activate
Range('A1:A10').Select
Selection.Copy
Windows('1.xls').Activate
Range('A1').Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Referme 2.xls
Windows('2.xls').Activate
ActiveWindow.Close
'Save as et remplace le 2.xls par 1.xls ...(Ancien Model.xls)
ActiveWorkbook.SaveAs Filename:= _
'C:\\Documents and Settings\\Claude\\Mes documents\\2.xls', FileFormat:=xlNormal _
, Password:='', WriteResPassword:='', ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
End Sub
Merci beaucoup
A++
Temjeh