Verifier si classeur ouvert

Bonjour

J'ai un problème à copier des valeurs sur un classeur qui est déjà ouvert et je bloque.

Pourriez vous svp m'aider?

Je cherche à copier des valeurs de plages de cellules de la feuille active à la feuille "VIERGE" du classeur "testrepas".

J'ai une fonction qui permet de vérifier si le classeur "testrepas" est déja ouvert

Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function

et j'ai ensuite cette procédure pour coller les valeurs

Private Sub CommandButton114_Click()
    Dim suiviWkb As Workbook: Dim suiviWks As Worksheet
    Dim suiviWkb14 As Workbook: Dim suiviWks14 As Worksheet
    sfichier = "\\ADIMC-DATA\UsersNov$\fhpersycat\Documents\testrepas.xlsx"
    Set suiviWkb = ActiveWorkbook
    Set suiviWks = ActiveSheet

    Date1 = suiviWks.Range("c2").Value
    suiviWks.Range("c5:ad72").Select
    Selection.Copy

    Dim xRet As Boolean
    xRet = IsWorkBookOpen("testrepas.xlsx")
    If xRet Then
        MsgBox "Le fichier est ouvert", vbInformation, "Kutools for Excel"
    Else
        MsgBox "le fichier n'est pas ouvert", vbInformation, "Kutools for Excel"
        Set suiviWkb14 = Workbooks.Open(Filename:=sfichier, ReadOnly:=False)
        Set suiviWks14 = suiviWkb14.Sheets("VIERGE")
    End If

    Set suiviWkb14 = Workbooks("testrepas.xlsx")
    Set suiviWks14 = suiviWkb14.Sheets("VIERGE")
    suiviWks14.Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    suiviWks14.Range("C2").Value = Date1
    MsgBox suiviWks14.Range("c2")

    suiviWkb.Activate
    suiviWks.Range("ag5:ag20").Select
    Selection.Copy
    suiviWkb14.Activate
    suiviWks14.Range("ag5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    suiviWkb.Activate
    suiviWks.Range("ag25:ag32").Select
    Selection.Copy
    suiviWkb14.Activate
    suiviWks14.Range("ag25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    suiviWkb.Activate
    suiviWks.Range("c74:aa75").Select
    Selection.Copy
    suiviWkb14.Activate
    suiviWks14.Range("c74").Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub

Tout fonctionne bien quand le classeur 'testrepas" n'était pas ouvert

MAIS quand il est déjà ouvert, il y a une erreur : "erreur d'execution 1004 : la methode select de la classe range a échoué" à cette ligne

suiviWks14.Range("C5").Select

Je veux que le classeur "testrepas" ne soit pas en lecture seule.

Je vous remercie beaucoup de votre aide

Cordialement

bonjour,

le select ne fonctionne que si le parent est sélectionné ou actif. (pour sélectionner une plage, il faut que la feuille soit active, pour sélectionner/activer la feuille il faut que le classeur soit actif).Le mieux est d'éviter les select/activate.

proposition de correction (non testé)

Private Sub CommandButton114_Click()
    Dim suiviWkb As Workbook: Dim suiviWks As Worksheet
    Dim suiviWkb14 As Workbook: Dim suiviWks14 As Worksheet
    sfichier = "\\ADIMC-DATA\UsersNov$\fhpersycat\Documents\testrepas.xlsx"
    Set suiviWkb = ActiveWorkbook
    Set suiviWks = ActiveSheet

    Date1 = suiviWks.Range("c2").Value
    suiviWks.Range("c5:ad72").Copy

    Dim xRet As Boolean
    xRet = IsWorkBookOpen("testrepas.xlsx")
    If xRet Then
        MsgBox "Le fichier est ouvert", vbInformation, "Kutools for Excel"
            Set suiviWkb14 = Workbooks("testrepas.xlsx")
    Set suiviWks14 = suiviWkb14.Sheets("VIERGE")
    Else
        MsgBox "le fichier n'est pas ouvert", vbInformation, "Kutools for Excel"
        Set suiviWkb14 = Workbooks.Open(Filename:=sfichier, ReadOnly:=False)
        Set suiviWks14 = suiviWkb14.Sheets("VIERGE")
    End If

    suiviWks14.Range("C5").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    suiviWks14.Range("C2").Value = Date1
    MsgBox suiviWks14.Range("c2")

    suiviWkb.Activate
    suiviWks.Range("ag5:ag20").Copy
    suiviWks14.Range("ag5").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    suiviWks.Range("ag25:ag32").Copy

    suiviWks14.Range("ag25").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    suiviWks.Range("c74:aa75").Copy
    suiviWks14.Range("c74").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub

Bonjour à tous,

Voici une proposition avec une autre fonction qui, au lieu de retourner un booléen, renvoie directement un objet workbook :

Function AffecterClasseur(chemin$) As Workbook
On Error Resume Next
Set AffecterClasseur = Workbooks(Split(chemin, "\")(UBound(Split(chemin, "\"))))
If Err.Number = 9 Then Set AffecterClasseur = Workbooks.Open(chemin)
End Function

Si le classeur est ouvert, il est affecté à la variable directement, sinon, il est ouvert et affecté lors de son ouverture. Si la fonction retourne nothing, c'est qu'il n'est pas trouvé.

A utiliser ainsi (avec une réorganisation du code) :

Private Sub CommandButton114_Click()
dim suiviWkb14 as workbook, sfichier$, tRef as variant
sfichier$ = "\\ADIMC-DATA\UsersNov$\fhpersycat\Documents\testrepas.xlsx"
Set suiviWkb14 = AffecterClasseur(sfichier)
if suiviWkb14 is nothing then msgbox "Fichier introuvable", 16: exit sub
tRef = array("C5:AD72", "C2", "AG5:AG20", "AG25:AG32", "C74:AA75")
CopierDans thisworkbook.activesheet, suiviWkb14.sheets("VIERGE"), tRef
end sub

Sub CopierDans(wsSource as worksheet, wsDest as worksheet, RefPlage)
for i = lbound(RefPlage) to ubound(RefPlage)
    wsDest.Range(RefPlage(i)).value = wsSource.Range(RefPlage(i)).value
next i
End Sub

NB : La fonction et la macro CopierDans sont à saisir dans un module normal !

Cdlt,

ca fonctionne parfaitement

Merci beaucoup de votre aide

Cordialement