Macro - Ouverture de plusieurs classeurs et insertion d'une feuille et ses formules

[bobylaroche]

Bonjour à tous,

Dans la série, j'essaye des trucs et je m'embrouille.
J'ai un classeur "maitre" qui possède une feuille nommée "EXPORT".
Par macro, je souhaiterai exporter cette feuille et ses formules dans tous les classeurs se trouvant dans le dossier "Ajout Page". A titre indicatif, les classeurs du dossier "Ajout Page" portent des noms différents mais ont le même nombre de feuilles.

Je voulais m'inspirer de ce code que j'utilise pour changer l'emplacement d'une cellule dans un certain nombre de classeurs mais pour le coup je bute sur la macro à adopter.
Si quelqu'un à une idée, merci.


Sub Reparation()

Dim myPath As String, myFile As String
myPath = "C:\Users\*******\Desktop\Reparation"
myFile = Dir(myPath & "\*.*")
Do While myFile <> ""
Call ClasseurOuvert(myPath & "\" & myFile)
With Workbooks(myFile)


'''''''''''''''''''''''''' Partie de la macro que je souhaiterai modifier.

Sheets("RECHA").Range("Ha39").Value = Sheets("FINAL").Range("AE40").Value

'''''''''''''''''''''''''
'.Close
End With
myFile = Dir()
Loop
End Sub
Function ClasseurOuvert(NomFich)
On Error Resume Next
Workbooks(NomFich).Activate
If Err <> 0 Then Workbooks.Open Filename:=NomFich
On Error GoTo 0
End Function

 

[Hieu]

Salut,

A tester :

Sub Reparation()

Dim myPath As String, myFile As String
myPath = "C:\Users\*******\Desktop\Reparation"
myFile = Dir(myPath & "\*.*")
nom = ThisWorkbook.Name
Do While myFile <> ""
Call ClasseurOuvert(myPath & "\" & myFile)
With Workbooks(myFile)


'''''''''''''''''''''''''' Partie de la macro que je souhaiterai modifier.

    Workbooks(nom).Sheets("EXPORT").Copy Before:=.Sheets(1)

'''''''''''''''''''''''''
'.Close
End With
myFile = Dir()
Loop
End Sub
Sub ClasseurOuvert(NomFich)
On Error Resume Next
Workbooks(NomFich).Activate
If Err <> 0 Then Workbooks.Open Filename:=NomFich
On Error GoTo 0
End Sub

J'ai change "ClasseurOuvert" en sub, car, pour moi, ce n'est pas une fonction

 

[bobylaroche]

Salut,

Merci bien pour ton aide, c'est sympa.

Cela fonctionne mais j'ai quelques soucis.

Un message d'alerte concernant les formats.
J'essaye de les supprimer avec "Application.AffichageMessagesAlerte = Faux" mais sans résultat pour le moment.

Puis les classeurs restent ouverts alors que je souhaite qu'ils se ferment automatiquement au fur et à mesure.

J'ai aussi l'intitulé de la feuille qui reste dans les cellules de la feuille export.
Peut être le supprimer à l'aide d'une macro à moins qu'il y est plus simple.

=SIERREUR([AjoutPage.xlsm]Accueil!CQ13;"")
au lieu de =SIERREUR(Accueil!CQ13;"")

Quand penses tu ?

Merci

 

[bobylaroche]

Hello,

J'en suis là.

Demande de mise à jour des classeurs résolu en ajoutant UpdateLinks:=0
Suppression de [AjoutPage.xlsm] résolu aussi.

Reste la sauvegarde et la fermeture des classeurs au fur et à mesure.



Sub AjoutPage()

Application.DisplayAlerts = False

Dim myPath As String, myFile As String
myPath = "C:\Users\Kizuna\Desktop\AjoutPage"
myFile = Dir(myPath & "\*.*")
nom = ThisWorkbook.Name

Do While myFile <> ""
Call ClasseurOuvert(myPath & "\" & myFile)
With Workbooks(myFile)

Workbooks(nom).Sheets("EXPORT").Copy Before:=.Sheets(1)

Workbooks(myFile).Sheets("EXPORT").Select
Cells.Select
Selection.Replace What:="[AjoutPage.xlsm]", Replacement:="", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Close
End With
myFile = Dir()
Loop
End Sub
Sub ClasseurOuvert(NomFich)

On Error Resume Next
Workbooks(NomFich).Activate
If Err <> 0 Then Workbooks.Open Filename:=NomFich, UpdateLinks:=0
On Error GoTo 0
End Sub

 

[bobylaroche]

C'est terminé, je me suis moins embrouillé qu'hier.


Sub AjoutPage()

Application.DisplayAlerts = False

Dim myPath As String, myFile As String
myPath = "C:\Users\Kizuna\Desktop\AjoutPage"
myFile = Dir(myPath & "\*.*")
nom = ThisWorkbook.Name

Do While myFile <> ""
Call ClasseurOuvert(myPath & "\" & myFile)
With Workbooks(myFile)

Workbooks(nom).Sheets("EXPORT").Copy Before:=.Sheets(1)

Workbooks(myFile).Sheets("EXPORT").Select
Cells.Select
Selection.Replace What:="[AjoutPage.xlsm]", Replacement:="", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

ActiveWorkbook.Save: ActiveWorkbook.Close

End With
myFile = Dir()
Loop
End Sub
Sub ClasseurOuvert(NomFich)

On Error Resume Next
Workbooks(NomFich).Activate
If Err <> 0 Then Workbooks.Open Filename:=NomFich, UpdateLinks:=0
On Error GoTo 0
End Sub

 

[Hieu]

Très bien ^^

Pense à mettre des balises, la prochaine fois, que tu postes ton code :[c ode=vb] [/c ode](sans l'espace)

 

[bobylaroche]

Merci pour ton aide Hieu