Vérifier si mon fichier est ouvert

Bonjour à tous,

J’espère que vous allez bien,

Dans mon premier fichier en pièce jointe nommée "copy db_A", j'ai une feuille nommée "Feuil1" qui possède un bouton nommé "Copy". Ce bouton permet de copier les données du fichier "copy db_B" vers le fichier "copy db_A" sans que le fichier "copy db_B" ne soit ouvert. Les données sont stockées sur la feuille LISTE PHARMACIE

Jusque-là tout vas bien.

Le souci est que j’ai ajouté une condition de vérification (voir code ci-dessous) et j’aimerai que :

• si le fichier copier (en l’occurrence le fichier copy db_B) est « ouvert » au moment de la copie, la copie des données se fait et "copy db_B" doit rester toujours ouvert.
• Mais si le fichier "copy db_B" est fermé au moment de la copie des données, la copie se fait toujours et à la fin, le fichier "copy db_B" se referme.

    If IsFileOpen("C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_B.xlsm") Then

'        MsgBox "Attention, le fichier est ouvert par un autre utilisateur ! Fin du traitement Réessayer, plus tard."
    '--- Ne rien faire ---
'    Exit Sub

    Else 'Fichier non ouvert
    wbSource.Close SaveChanges:=False
    End If

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next
    filenum = FreeFile()

    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0

    Select Case errnum

        Case 0
         IsFileOpen = False

        Case 70
         IsFileOpen = True

        Case Else
         Error errnum
    End Select

End Function

J’ai tout tenté, mais dans les 2 scénarios, le fichier "copy db_B" se referme toujours et je ne comprends rien. Pourriez-vous me dire ce qui ne va pas s’il vous plait ?

NB : j’aimerai aussi que le message, ci-dessous, ne s’affiche plus lorsque j’exécute ma macro.

En vous remerciant de votre aide.

Dans l’attente vos retour,

Cordialement

Hello,

Ta fonction IsFileOpen est ok.

Pour le code du bouton copy :

Sub CopierDonnees()

    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim cheminSource As String
    Dim fichierOuvert As Boolean

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    cheminSource = "C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_B.xlsm"
    Set wbDest = ThisWorkbook  ' fichier copy db_A

    ' Vérifier si le fichier source est ouvert
    fichierOuvert = IsFileOpen(cheminSource)

    If fichierOuvert Then
        ' Le fichier est ouvert : on récupère la référence sans l'ouvrir
        On Error Resume Next
        Set wbSource = Workbooks("copy db_B.xlsm")
        On Error GoTo 0
        If wbSource Is Nothing Then
            MsgBox "Le fichier est signalé ouvert mais n'est pas accessible, merci de vérifier.", vbExclamation
            Exit Sub
        End If
    Else
        ' Le fichier est fermé : on l'ouvre en invisible
        Set wbSource = Workbooks.Open(Filename:=cheminSource, UpdateLinks:=False, ReadOnly:=True)
    End If

    ' Copier les données
    Set wsSource = wbSource.Worksheets("LISTE PHARMACIE")
    Set wsDest = wbDest.Worksheets("Feuil1")

    wsDest.Cells.ClearContents 'ou adapter selon besoins
    wsSource.UsedRange.Copy wsDest.Range("A1")

    ' Fermer le fichier source uniquement s'il a été ouvert par la macro
    If Not fichierOuvert Then
        wbSource.Close SaveChanges:=False
    End If

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "Copie terminée !", vbInformation

End Sub

Pour le message d’erreur tu mets cette ligne que tu repasseras à True une fois que l’erreur est passée.

Application.DisplayAlerts = False

@+

Merci BAROUTE78,

Tu es super rapide.

Je teste et je re reviens.

A tout à l'heure

BAROUTE78,

Ton code fonctionne bien et la copie des données est super rapide.

Par contre, la copie des données doit se faire sur la feuille "LISTE PHARMACIE" et non sur "Feuil1" : j'ai corrigé.

1- J'aimerai que seul les données soit copiées et non les "en-tête", soit à partir de A2 de la feuille "LISTE PHARMACIE", peux-tu corrigé ça s'il te plait ?

2- J'aimerai savoir, au cas où mes fichiers se trouvent dans un "même" dossier partagé mais sur un serveur, le chemin Source sera toujours égale au chemin ci-dessous ?

"C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_B.xlsm"

3- J'ai le code ci-dessous, qui permet de copier un fichier en vba, mais j'ai une erreur aussi. Pourriez-vous me dire ce qui ne va pas s’il vous plait ?

    Dim sourceFile As String, destinationFile As String
    sourceFile = "C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_A.xlsm"
    destinationFile = "C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_B.xlsm"
    FileCopy sourceFile, destinationFile
    MsgBox "Fichier copié avec succès !"

Bonjour Past007

Quand vous copiez le fichier en VBA, vous êtes dans quel classeur à ce moment là

Hello,

Avec ceci peut être normalement

Sub CopierDonnees()

    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim cheminSource As String
    Dim fichierOuvert As Boolean
    Dim lastRow As Long

    On Error GoTo FinAvecErreur
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    cheminSource = "C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_B.xlsm"
    Set wbDest = ThisWorkbook  ' copy db_A

    fichierOuvert = IsFileOpen(cheminSource)

    If fichierOuvert Then
        Set wbSource = Workbooks("copy db_B.xlsm")
        If wbSource Is Nothing Then
            MsgBox "Le fichier est ouvert mais inaccessible.", vbExclamation
            GoTo FinSansErreur
        End If
    Else
        Set wbSource = Workbooks.Open(Filename:=cheminSource, UpdateLinks:=False, ReadOnly:=True)
    End If

    Set wsSource = wbSource.Worksheets("LISTE PHARMACIE")
    Set wsDest = wbDest.Worksheets("LISTE PHARMACIE")

    wsDest.Cells.ClearContents

    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    If lastRow >= 2 Then
        wsSource.Range("A2", wsSource.Cells(lastRow, wsSource.UsedRange.Columns.Count)).Copy Destination:=wsDest.Range("A1")
    Else
        MsgBox "Pas de données à copier après l'en-tête.", vbExclamation
    End If

FinSansErreur:
    If Not fichierOuvert Then
        wbSource.Close SaveChanges:=False
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Copie terminée !", vbInformation
    Exit Sub

FinAvecErreur:
    MsgBox "Erreur : " & Err.Description, vbCritical
    Resume FinSansErreur

End Sub

Concernant le chemin, si c’est une un répertoire réseau, ce ne sera pas le lecteur C mais plutôt un chemin commençant par //toto/dossier1/dossier2/xxxx.xlsm

Pour la copie d’un fichier en VBA, ce code fonctionne bien, on me l’avait filé à une époque et c’est plutôt propre.

Sub CopierFichier()

    Dim sourceFile As String, destinationFile As String

    sourceFile = "C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_A.xlsm"
    destinationFile = "C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_B.xlsm"

    On Error GoTo GestionErreur

    FileCopy sourceFile, destinationFile
    MsgBox "Fichier copié avec succès !", vbInformation
    Exit Sub

GestionErreur:
    MsgBox "Erreur lors de la copie : " & Err.Description, vbCritical

End Sub

@+

Bonjour BAROUTE78

Bonjour à tous et désolé du retard.

BAROUTE78, je test tes codes et je te reviens très vite.

Merci encore

BAROUTE78, j'ai testé ton code sur la copie du fichier et j'ai toujours la même erreur (voir image ci-dessous).

JExcelL2fr, j'ai également changé de dossier en passant du "C:\" au "D:\", mais c'est toujours la même erreur lors de l'exécution du code.

BAROUTE78, concernant la copie (disons le transfert) des données du fichier B au fichier A, ta modification fonctionne bien, mais (malheureusement) il supprimer le tableau "BaseRH" qui est dans le fichier vba et j'ai besoin de ce tableau pour travailler.

Ci-joint, le fichier vba qui contient le tableau "BaseRH".

Merci encore pour vos contribution.

Dans l'attente de vos retour,

Cordialement

Salut Past007

Pour être plus explicite, ma question était : est-ce que le code copie le fichier dans lequel tu es vers un autre dossier et nom ?

A+

oui oui JExcelL2fr, le code copie le fichier dans lequel je suis, le colle et le renomme avec un autre nom.

Plus précisément, le code copie le fichier nommé "copy db_A" et le renomme en "copy db_B".

NB : j'aimerai aussi que lors de la copie, si le fichier "copy db_B" existe déjà, il doit-être remplacé par le nouveau fichier, mais sans message d'avertissement.

Merci encore pour vos contribution.

Dans l'attente de vos retour,

Cordialement

Re,

C'est bien ce que je pensais

Et vous ne comprenez pas pourquoi vous avez une erreur d'accès...

Faites donc tout simplement ceci

Sub CopieClasseurActif()
  Dim DestinationFile As String
  DestinationFile = "C:\Users\LEAD CONSEILS\Desktop\Travaux VBA\FORUM\copy vba_07062025\copy db_B.xlsm"
  ThisWorkbook.SaveCopyAs DestinationFile
  MsgBox "Fichier copié avec succès !"
End Sub

A+

Merci JExcelL2fr,

Je teste ton code et te reviens.

Mais j'ai une autre question : si jamais la copie devait se faire dans le même dossier, comment on procède s'il te plait ?

Re,

Oups... oublié de supprimer ma ligne test

C'est corrigé et ça répond à la question bête...

Bonjour JExcelL2fr,

Bonjour à tous,

JExcelL2fr, j'ai du mal à comprendre ton dernière message où tu dis que tu as "oublié de supprimer la ligne test".

Au groupe, j'aimerai savoir si jamais la copie devait se faire dans le même dossier, comment on procède s'il vous plait ?

Merci encore pour vos contribution.

Dans l'attente de vos retour,

Cordialement

Re,

Et bien moi j'ai du mal à comprendre la question

" j'aimerai savoir si jamais la copie devait se faire dans le même dossier, comment on procède s'il vous plait ?"
Ce n'est pas le chemin indiqué initialement

Sinon pour ne pas le mettre en dur, vous pouvez très bien définir une variable

Sub CopieClasseurActif()
  Dim DossierActuel As String
  Dim DestinationFile As String
  DossierActuel = ThisWorkbook.Path
  DestinationFile = DossierActuel & "\copy db_B.xlsm"
  ThisWorkbook.SaveCopyAs DestinationFile
  MsgBox "Fichier copié avec succès !"
End Sub

Mais avec 121 messages à votre actif, vous devriez commencer à le savoir... non !

Bonjour JExcelL2fr,

Bonjour à tous,

Merci