Bonjour à tous,
j'ai réalisé une macro qui me ramène dans un seul fichier Excel plusieurs feuilles d'autres documents sous forme d'un tableau de synthèse.
Sous Excel 2010 cela fonctionne parfaitement sauf que lorsque j'exécute la macro sous Excel 2007 cela génère une Erreur 1004 : "Erreur définie par l'application ou par l'objet".
Il semble que l'erreur apparaisse à la ligne suivante :
Set wb2 = Workbooks.Open(sPath & sFilename) 'Ouvre le fichier
Avez vous une idée de correction ? ci dessous mon code :
Encore merci d'avance à tous pour votre aide.
Sub Ouvrir_Fichiers_2()
' Permet d'ouvrir plusieurs fichiers dans un répertoire
Dim wb As Workbook, wb2 As Workbook
Dim sPath As String, sFilename As String
Dim NbRows As Integer, rg As Range
Application.DisplayAlerts = False
Dim Ws As Worksheet
For Each Ws In Worksheets
Application.DisplayAlerts = False
If Ws.Name <> "dashboard" Then
If Ws.Name <> "Logos" Then Ws.Delete
End If
Next
Set wb = ThisWorkbook
origine = ActiveWorkbook.Name
Application.ScreenUpdating = False
sPath = "C:\Users\User\Desktop\Nouveau dossier\fsp\test_liste\" 'Répertoire
sFilename = Dir(sPath & "*.xlsm*") 'ouvre tous les fichiers .xlsm*
Do While Len(sFilename) > 0
Set wb2 = Workbooks.Open(sPath & sFilename) 'Ouvre le fichier
Dim chemin As String, pos&
chemin = ActiveWorkbook.Name
pos = InStr(chemin, ".xlsm")
titre = Left(chemin, pos - 1)
wb2.Sheets("FSP-ini").Select
ActiveSheet.Unprotect ""
wb2.Sheets("FSP-ini").Copy After:=Sheets(1)
ActiveSheet.Name = titre
wb2.Activate
ActiveSheet.Unprotect ""
Range("AW11").Copy
wb.Activate
Range("AW11").Select
ActiveSheet.Paste
wb2.Activate
ActiveSheet.Unprotect ""
Range("AW26").Copy
wb.Activate
Range("AW26").Select
ActiveSheet.Paste
ActiveSheet.Unprotect ""
Range("AW34:AW35").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AW37:AW38").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AW45:AW46").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'suppression des noms
Dim N As Name
With ActiveSheet
For Each N In .Names
N.Delete
Next
End With
Application.AskToUpdateLinks = False
wb2.Close False 'Fermer le fichier
sFilename = Dir
Loop
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub