VBA : Probleme sur macro d'import

Fermé
actaris51 - 14 août 2009 à 10:42
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 - 14 août 2009 à 21:23
Bonjour,
J'utilise la macro ci dessous pour importer des données dans mon fichier.
Le problème, c'est qu'au passage :
Set classeurSource = Application.Workbooks.Open(Fichier_Travail, , True)
il me met le message d'erreur : le fichier source est déja ouvert, voulez vous le réouvrir etc...
Est-ce a cause du .open ?
J'ai utilisé cette macro pour ouvrir un autre fichier, et ce message n'apparait pas, je ne comprend pas.
Pouvez vous m'aider ?
Merci


Sub Import_Risks()
Application.ScreenUpdating = False

Dim Fichier_Travail As String, Fichier As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim classeurSource As Workbook, classeurDestination As Workbook

ChDrive CHEMIN2
ChDir CHEMIN2

'Set une variable qui va contenir le nom et le chemin du fichier à ouvrir.
Fichier = Application.GetOpenFilename("Excel Files (*.xls), *.xls", 1, "Select the supplier extract") 'On ouvre la fenêtre et conserve le nom du fichier choisi dans une variable

'Test si un fichier a été sélectionné
If Fichier = "Faux" Then
Msg = "Aucun fichier sélectionné. SVP, veuillez recommencer !" ' Définit le message.
Style = vbOKOnly ' Définit les boutons.
Title = "Abandon de la procédure !" ' Définit le titre.
' Affiche le message.
Response = MsgBox(Msg, Style, Title)
Exit Sub 'Sort de la macro puisqu'aucun fichier n'a été sélectionné
Else 'Sinon, on ouvre le fichier sélectionné
Workbooks.OpenText Filename:=Fichier
Fichier_Travail = ActiveWorkbook.Name 'On donne à une variable le nom de ce fichier qu'on vient d'ouvrir.
End If
'ouvrir le classeur source (en lecture seule)
Set classeurSource = Application.Workbooks.Open(Fichier_Travail, , True)
'définir le classeur destination
Set classeurDestination = ThisWorkbook

'copier les données du classeur source vers le classeur destination

classeurSource.Sheets("Risks").Range("A1:BE1000").Copy
With classeurDestination.Sheets("Risks_Database").Range("A1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats 'Optionnel
End With


'Vide le presse papiers
Application.CutCopyMode = False
'fermer le classeur source
classeurSource.Close False
End Sub

1 réponse

melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 155
14 août 2009 à 21:23
Bonjour,

je regarde ton code et quelque chose m'échappe.
D'après ton code, tu ouvres un fichier qui s'appelle fichier puis ce fichier s'appelle fichier de travail.
Tu cherches à ouvrir le fichier de travail (alors qu'il est déjà ouvert) d'ou ton problème.
et tu dis que ton fichier source = ton fichier destination.


voici le code corrigé

Sub Import_Risks()
Application.ScreenUpdating = False

Dim Fichier_Travail As String, Fichier As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim classeurSource As Workbook, classeurDestination As Workbook

'définir le classeur destination
classeurDestination = activeworkbook.name
ChDrive CHEMIN2
ChDir CHEMIN2

'Set une variable qui va contenir le nom et le chemin du fichier à ouvrir.
Fichier = Application.GetOpenFilename("Excel Files (*.xls), *.xls", 1, "Select the supplier extract") 'On ouvre la fenêtre et conserve le nom du fichier choisi dans une variable

'Test si un fichier a été sélectionné
If Fichier = "Faux" Then
Msg = "Aucun fichier sélectionné. SVP, veuillez recommencer !" ' Définit le message.
Style = vbOKOnly ' Définit les boutons.
Title = "Abandon de la procédure !" ' Définit le titre.
' Affiche le message.
Response = MsgBox(Msg, Style, Title)
Exit Sub 'Sort de la macro puisqu'aucun fichier n'a été sélectionné
Else 'Sinon, on ouvre le fichier sélectionné
Workbooks.OpenText Filename:=Fichier
Fichier_Travail = ActiveWorkbook.Name 'On donne à une variable le nom de ce fichier qu'on vient d'ouvrir.
End If



'copier les données du classeur source vers le classeur destination

Fichier_Travail .Sheets("Risks").Range("A1:BE1000").Copy
With classeurDestination.Sheets("Risks_Database").Range("A1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats 'Optionnel
End With


'Vide le presse papiers
Application.CutCopyMode = False
'fermer le classeur source
classeurSource.Close False
End Sub
0