Macro qui vérifie si fichier ouvert et renvoie message si pas ouvert

Bonjour,

Je viens vers vous car je bloque dans la réalisation d'une macro en VBA.

J'ai fait plusieurs recherches sur le support microsoft, différents sujets avec des mots clés liés à mon problème. J'ai trouvé quelques informations j'ai essayé d'adapter des macros, puis d'en faire une mois même.

J'ai finalement trouvé une partie de la solution mais il reste une zone d'ombre sur ma réalisation.

Je vous donne plus de détails.

Je tente en fait de réaliser une macro qui vérifie si un fichier est bien ouvert, si c'est le cas elle réalise la macro réalisée avec l'enregistreur de macro, sinon elle renvoie un message "ouvrir le fichier".

Ainsi, lorsque le fichier est bien ouvert, cela marche bien et la macro qui vise à déplacer des données d'une feuille du premier fichier au second fonctionne.

Mais si le fichier n'est pas ouvert, cela me renvoie une erreur d'exécution 9.

Sub Transférer()

If Windows("Suivi Quadri v1.0.xlsx").Activate Then

Application.WindowState = xlNormal
    Windows("Fichier qui reçoit la donnée.xlsx").Activate
    Sheets("IMPORT").Select
    Range("A1:O400").Select
    Selection.ClearContents
    Windows("Fichier qui a la donnée.xlsm").Activate
    Range("A1:O400").Select
    Selection.Copy
    Windows("Fichier qui reçoit la donnée.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("Fichier qui a la donnée.xlsm").Activate
    MsgBox ("Transfert réalisé.")

Else

    MsgBox ("Fichier n'est pas ouvert.")

End If

End Sub

Je ne trouve aucune piste pour résoudre ce problème à savoir que je ne souhaite pas que la macro force l'ouverture du fichier via un chemin d'accès. Je n'ai pas joint de fichier en pj car si j'ai bien compris ils ne sont pas forcément ouverts pour des raisons de sécurité. Mais si vous souhaitez que j'en joigne un je peux le faire :)

Je vous remercie par avance pour vos pistes ! Car là je suis un peu perdu, j'ai très certainement dû rater quelque chose d'évident.

bonjour,

une proposition avec un impact minimum sur ton code.

Sub Transférer()
    On Error GoTo terreur
    If Windows("Suivi Quadri v1.0.xlsx").Activate Then

        Application.WindowState = xlNormal
        Windows("Fichier qui reçoit la donnée.xlsx").Activate
        Sheets("IMPORT").Select
        Range("A1:O400").Select
        Selection.ClearContents
        Windows("Fichier qui a la donnée.xlsm").Activate
        Range("A1:O400").Select
        Selection.Copy
        Windows("Fichier qui reçoit la donnée.xlsx").Activate
        Range("A1").Select
        ActiveSheet.Paste
        Windows("Fichier qui a la donnée.xlsm").Activate
        MsgBox ("Transfert réalisé.")

fin:
        Exit Sub
    End If
terreur:
    If Err = 9 Then
        MsgBox "veuillez ouvrir le fichier Suivi Quadri ..."
    Else
        MsgBox "une erreur est survenue : erreur " & Err
    End If
    Resume fin
End Sub

Bonjour,

ça a l'air de fonctionner à merveille ! J'étais loin du compte quand je vois ta réponse !!! Merci beaucoup pour ton aide.

Je ne pensais pas en effet qu'il fallait prendre le problème du côté de l'erreur. Je pensais qu'il y avait absolument une solution avec le ELSE si la première hypothèse n'était pas vérifiée.

Merci beaucoup !!

bonjour,

une autre solution, allégée des instructions superflues de l'enregistreur de macro et qui intègre l'ouverture du fichier s'il n'est pas ouvert.

Sub Transférer()
    Dim wb As Object 'wb =fichier source 
    Application.WindowState = xlNormal
    On Error Resume Next
    Set wb = Workbooks("Suivi Quadri v1.0.xlsx") 
    On Error GoTo 0
    If wb Is Nothing Then
        'on ouvre le fichier s'il n'est pas ouvert
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            If .Show Then
                Set wb = Workbooks.Open(.SelectedItems(1))
            Else
                MsgBox " aucun fichier sélectionné"
                Exit Sub
            End If
        End With
    End If
    'on copie les données du fichier source vers le fichier destination
    With Workbooks("Fichier qui reçoit la donnée.xlsx")
        wb.Sheets(1).Range("A1:O400").Copy .Sheets("IMPORT").Range("A1")
        wb.Close False
        MsgBox ("Transfert réalisé.")
    End With
End Sub

Ah oui merci elle est vraiment parfaite :O !!

Merci beaucoup pour ton amélioration ! :)