VBA - Problème Copie à partir de classeurs ouverts

Mischief

XLDnaute Nouveau
Bonjour le Forum ! :)

Je découvre un peu VBA depuis quelques semaines mais je suis confronté à un obstacle.
Je vais essayer d'être le plus clair possible car je ne suis pas sur qu'un fichier exemple soit très utile dans mon cas (mais corrigez moi si je me trompe).

Voilà ce que j'essaye de faire : je dispose de plusieurs fichiers clients, tous similaires, avec une feuille "Database" dans laquelle on trouve des intitulés de colonnes et simplement des lignes contenant des données, chaque ligne correspondant à une "visite".
Je souhaite ajouter les unes en dessous des autres toutes ces visites dans un autre fichier Excel, mais contenant cette fois tous les clients.

Ma méthode : Mettre tous les fichiers clients dans un dossier (dont le chemin se trouvera dans la case B1 du fichier-destination) et utiliser une macro pour récupérer les données dans tous les fichiers de ce dossier pour les ajouter les unes en dessous des autres.

J'ai donc bricolé un code avec ce que j'ai trouvé à droite à gauche. Il n'est surement pas élégant du tout mais ce code fonctionne quand tous les fichiers sont fermés. J'ai donc voulu ensuite ajouter une façon de gérer le cas des fichiers qui sont ouverts : je détecte si le fichier est ouvert/fermé, entre le résultat dans une variable Boolean et utilise IF pour gérer les deux cas différemment. Il y a d'autres méthodes que celle que j'ai utilisé mais je n'ai pas réussi à utiliser la gestion d'erreur et GoTo.

Bref, voilà mon code :

Code:
Sub UPDATING()

    Dim FolderWay As String
    Dim VarFileName As String
    Dim VarFile As Workbook
    Dim CopySource As Range
    
    Dim Flag As Boolean
    Dim Wb As Excel.Workbook
    Dim Appli As Excel.Application
  
   
Application.ScreenUpdating = False
Set Appli = GetObject(, "Excel.Application")


    Range("A8:AH1000").ClearContents
    
'le chemin du dossier à utiliser se trouve dans la case B1
    FolderWay = Range("B1").Value & "\" & "" 
    VarFileName = Dir(FolderWay & "*.xls")
    FileCount = 0

'la boucle s'arrête quand on a utilisé tous les fichiers du dossier
     Do While Not VarFileName = ""     
       
 'la boucle suivante détecte si le fichier est ouvert
            Flag = False
            For Each Wb In Appli.Workbooks
                If Wb.Name = VarFileName Then
                Flag = True
                End If
            Next Wb


            If Flag = True Then       'on passe ici si le fichier est ouvert
                    Set VarFile = Workbooks(VarFileName)
                    Set CopySource = VarFile.Sheets("Database").Range("A8:AH" & Range("F65536").End(xlUp).Row)
        
                    ThisWorkbook.Sheets("List").Range("A" & ThisWorkbook.Sheets("List").Range("F65536").End(xlUp).Offset(1, 0).Row).Resize(CopySource.Rows.Count, CopySource.Columns.Count) _
                        = CopySource.Value
        
            Else                             'ici si le fichier est fermé    
                    Set VarFile = Application.Workbooks.Open(FolderWay & VarFileName)
                    Set CopySource = VarFile.Sheets("Database").Range("A8:AH" & Range("F65536").End(xlUp).Row)
        
                    ThisWorkbook.Sheets("List").Range("A" & ThisWorkbook.Sheets("List").Range("F65536").End(xlUp).Offset(1, 0).Row).Resize(CopySource.Rows.Count, CopySource.Columns.Count) _
                        = CopySource.Value
   
                    VarFile.Close SaveChanges:=False
        
            End If
             
    VarFileName = Dir
    Loop

Application.ScreenUpdating = True

End Sub



Voilà mon problème : La macro fonctionne toujours quand les différents fichiers-source sont fermés, mais parfois, quand l'un d'eux est ouvert, la macro ne me copie dans mon fichier-destination qu'un nombre tronqué de lignes. En utilisant MsgBox j'ai pas voir que l'utilisation du "CopySource.Columns.Count" (et donc probablement la méthode pour trouver la dernière ligne remplie de mes fichiers clients), qui marche bien par ailleurs, déconnait un brin sur les fichiers ouverts.

Je ne comprends pas pourquoi, et j'aimerais bien comprendre... voire trouver une solution! Si certains d'entre vous peuvent m'aider à y voir plus clair...

Merci à vous ! :) N'hésitez pas si vous avez des questions sur le pourquoi de mon code...
Et bien sur, si la méthode vous parait mauvaise, je suis complètement ouvert à d'autres pistes qui me mèneraient vers ce que je voudrais faire !
 
Dernière édition:
G

Guest

Guest
Re : VBA - Problème Copie à partir de classeurs ouverts

Bonjour,

Sans doute des variables (CopySource ou autre) à réinitialiser correctement.

Ci-dessous réorganisation du code:

Code:
Sub UPDATING()
Dim FolderWay As String
Dim VarFileName As String
Dim VarFile As Workbook
Dim CopySource As Range
    Application.ScreenUpdating = False
    Set Appli = GetObject(, "Excel.Application")

    Range("A8:AH1000").ClearContents
    'le chemin du dossier à utiliser se trouve dans la case B1
    FolderWay = Range("B1").Value & "\" & ""
    VarFileName = Dir(FolderWay & "*.xls")
    FileCount = 0
    'la boucle s'arrête quand on a utilisé tous les fichiers du dossier
    Do While Not VarFileName = ""
        '
        'la boucle suivante détecte si le fichier est ouvert
        Set VarFile = Nothing
        On Error Resume Next
        Set VarFile = Workbooks(strFileName)
        If VarFile Is Nothing Then Set VarFile = Application.Workbooks.Open(FolderWay & VarFileName)
        On Error GoTo 0
        '
        'Vérifier quand même que l'ouverture éventuelle s'est bien opérée et qu'on a classeur
        '
        If Not VarFile Is Nothing Then
        
            Set CopySource = VarFile.Sheets("Database").Range("A8:AH" & Range("F65536").End(xlUp).Row)
            ThisWorkbook.Sheets("List").Range("A" & ThisWorkbook.Sheets("List").Range("F65536").End(xlUp).Offset(1, 0).Row).Resize(CopySource.Rows.Count, CopySource.Columns.Count) _
                    = CopySource.Value
            VarFile.Close SaveChanges:=False
            
            'Réinitialiser La plage pour le classeur suivant
            Set CopySource = Nothing
        
        End If
        VarFileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

P.S. non testée Ar....

A+
 
Dernière modification par un modérateur:

Mischief

XLDnaute Nouveau
Re : VBA - Problème Copie à partir de classeurs ouverts

Bonjour Hasco, et merci pour ton aide!

J'aime mieux ce code, plus court et simple. En revanche, je cherche quand même à différencier les deux cas (classeur déjà ouvert ou non) au niveau de la fermeture du fichier, pour ne pas fermer sans enregistrer ceux qui étaient déjà ouvert. Je pense que ça doit être possible en ajoutant une simple variable Boolean servant de "marqueur" dans ton code...

En revanche, même problème avec ce code, le calcul de la dernière ligne de la plage à copier (ou alors le calcul du CopySource.Rows.Count, je ne sais pas) n'en fait toujours qu'à sa tête sur un fichier ouvert, alors que cela fonctionne sur un fichier fermé.
Si j'utilise cette façon de faire (avec la variable CopySource et la méthode Resize pour la destination), c'est d'une part pour éviter d'utiliser Copy/Paste et d'autre part pour pouvoir ne copier que les valeurs des cellules. Mais peut-être qu'il y a une solution différente et moins problématique pour parvenir à la même chose...

En tout cas, l'erreur vient peut-être de mes fichiers-source, je vais donc essayer de publier un exemple.

Merci encore en tout cas
 
G

Guest

Guest
Re : VBA - Problème Copie à partir de classeurs ouverts

Re,

Alors pour la première question:
Code:
 Set VarFile = Nothing
        bFlag = False
        On Error Resume Next
        Set VarFile = Workbooks(strFileName)
        bFlag = Not Workbooks Is Nothing
        If bFlag Is Nothing Then Set VarFile = Application.Workbooks.Open(FolderWay & VarFileName)
        On error Goto 0
        '
        '.....code de traitement du fichier
        '
        '
        '------Fermeture des fichiers qui n'étaient pas ouverts avant traitement
        If Not bFlag Then VarFile.Close SaveChanges:=False



Pour la seconde tu peux peut-être utiliser .CurrentRegion

A+
 

Mischief

XLDnaute Nouveau
Re : VBA - Problème Copie à partir de classeurs ouverts

Merci pour la solution. En revanche, en ce qui concerne .CurrentRegion, cela ne va-t-il pas inclure mes intitulés de colonnes en plus?

Bref, comme promis, voilà une archive avec mon fichier-destination et trois exemples de fichiers-source (ne pas faire attention aux formules). Le problème apparait bien quand l'un (ou plusieurs) des fichiers est ouvert, alors qu'il ne se produit pas lorsqu'ils sont fermés.
Le premier des fichiers trouvés par Dir pose particulièrement problème : il a tendance à être tronqué plus que les autres, et surtout, la macro me copie aussi l'intitulé des colonnes, ce qu'elle ne fait pas par ailleurs.

Je ne comprends plus du tout hahaha.
 
Dernière édition:
G

Guest

Guest
Re : VBA - Problème Copie à partir de classeurs ouverts

Re,

Complément à ma réponse précédente:

Mets ta plage de destination en variable et Vérifie son adresse, sa feuille et son WorkBook:
Dim plgDest as range

Set plgDest= ThisWorkbook.Sheets("List").Range("A" & ThisWorkbook.Sheets("List").Range("F65536").End(xlUp).Offset(1, 0).Row).Resize(CopySource.Rows.Count, CopySource.Columns.Count)

Code:
If Not Flag then
  MsgBox plgDest.Address & vbcrLF & plgDest.Parent.Name & vbcrlf & plgDest.Parent.Parent.Name
End If

A+
 
G

Guest

Guest
Re : VBA - Problème Copie à partir de classeurs ouverts

Re,

C'était le deuxième Range de la définition de la plage Source auquel il manquait la référence à la feuille et au classeur.

Quand tes fichiers étaient ouvert par macro ils devenaient les fichiers actifs et Range se rapportait donc au bon fichier. Mais quand ils étaient fermés, Le fichier de la macro restait le fichier actif donc Range s'y rapportait.

Solution:

Code:
With VarFile.Sheets("Database")
                Set CopySource = .Range("A8:AH" & .Range("F65536").End(xlUp).Row)
End With
Ou suivant ton mode d'écriture:

Code:
Set CopySource = VarFile.Sheets("Database").Range("A8:AH" & VarFile.Sheets("Database").Range("F65536").End(xlUp).Row)

Comme quoi il vaut mieux toujours joindre un fichier qui est toujours plus lisible qu'un post.

A+
 

Mischief

XLDnaute Nouveau
Re : VBA - Problème Copie à partir de classeurs ouverts

C'était bel et bien la clé !
C'était donc lié à une imprécision de ma part (plutôt du côté de la plage de destination j'ai l'impression), ou une mécompréhension de la propriété ThisWorkbook.

Merci beaucoup pour ton aide! Mon problème est résolu.
Bonne journée
 
G

Guest

Guest
Re : VBA - Problème Copie à partir de classeurs ouverts

Re,

A ben il faut voir l'aide excel pour cela;) F1

En l'occurence dans ton code cela donne en langage naturel:

on error : "si tu rencontre une erreur "
Resume next: "passe ton chemin et va à la ligne suivante"

Donc
On Error Resume Next
Set VarFile=WorkBooks('........')

On essaie de récupérer un classeur sensé être ouvert. S'il ne l'est pas Set VarFile va "lever" une erreur, comme on ne veut pas que cela nous embarrasse, on lui dit de passer quand même à la ligne suivante...où l'on peut tester si VarFile est un Classeur ou Nothing
Flag = not VarFile is Nothing

Par contre le On error Goto 0 (pour rétablir la gestion d'erreur par défaut) est important pour que le On error Resume Next précédent ne cache pas d'autres erreurs éventuelles.

Voilà

Allez jeter un oeil à La gestion des erreurs dans Excel

A++
 
Dernière modification par un modérateur:

Discussions similaires

Statistiques des forums

Discussions
312 176
Messages
2 085 959
Membres
103 061
dernier inscrit
Zebor