Copier-coller des données de classeurs fermés vers un classeur ouvert

Question

Bonjour,

Je souhaite ajouter une macro déjà maintes fois utilisée sur le forum mais je n'arrive pas à comprendre d'où vient l'erreur qui a été renvoyée par excel

Mon but est de copier coller des données qui sont toujours sur la même plage (F5:G36) de l'onglet "fiche" de 60 classeurs enregistrés dans un même dossier dans un onglet unique ("01") d'un classeur (en E5:F36) et en décalant à chaque fois la colonne sur la droite pour coller les données à la suite.

Voici la fonction utilisée récupérée d'un autre forum (sujet qui a 10 ans et auteur plus actif)

Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte

'ouverture de la fenêtre de choix du répertoire
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
'message
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else 'sinon
'Chemin = répertoire choisi
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
fichier = Dir(Chemin & "*.xls*")
'Colonne = n° de colonne ou on va coller les données
'pour commencer colonne A, laisser à 0, pour commencer colonne B remplacer 0 par 1 etc...
Colonne = 4
'on boucle sur tous les fichiers excel du répertoire choisi
Do While Len(fichier) > 0
Colonne = Colonne + 1
If fichier <> ThisWorkbook.Name Then
'attribue un nom dans le classeur, se référant à la plage à importer : F5:G36
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]fiche'!$F$5:$G$36"
With Sheets("01")
' "Importe les données" grâce au nom donné ci-dessus
.[F5:G36] = "=Plage"
.[E5:F36].Copy 'Copie E5:F36
End With
With Sheets("01")
.Cells(1, Colonne).PasteSpecial xlPasteValues 'Colle E5:F36
End With
End If
fichier = Dir()
Loop
End If
End Sub

Excel me donner l'erreur à la ligne ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]fiche'!$F$5:$G$36"

J'aimerais beaucoup un peu d'aide pour réussir à faire cette fonction !
En complément ultime, j'aimerais que ma fonction colle dans l'onglet actuel, pour pouvoir avoir un onglet différent par mois sans avoir à changer 12x la macro (remplacer Sheets("01") par Actual.worksheets (si cela existe) )

Merci d'avance !!

ThauThème · Accepted Answer

Bonjour Hellgz et bienvenu, Bruno, bonjour le forum,

Je souhaite ajouter une macro déjà maintes fois utilisée sur le forum mais je n'arrive pas à comprendre d'où vient l'erreur qui a été renvoyée par excel

Le problème est que tu ne nous dis ni quelle est l'erreur renvoyée ni sur quelle ligne !?...

J'ai fait tourner le code et je constate que la copie chevauche les première données récupérées. De plus tu colles une plage de deux colonnes et tu incrémentes d'une seule colonne ?!...

En pièce jointe une proposition. L'onglet O1 est obligatoire et ne doit jamais être l'onglet actif au lancement de la macro. C'est l'onglet intermédiaire ou vont être récupérées les données de chaque fiche. Ensuite ces données seront copiés/collées dans l'onglet actif et, pour finir, les valeurs de l'onglet O1 seront effacées...

Le code :

Sub Import()
Dim OI As Worksheet '(Onglet Intermédiare)
Dim OA As Worksheet 'Onget Actif)
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte

Set OI = Worksheets("01")
Set OA = ActiveSheet
OA.Cells.ClearContents
'ouverture de la fenêtre de choix du répertoire
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
    'message
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else 'sinon
    'Chemin = répertoire choisi
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    'Choix du 1er fichier
    fichier = Dir(Chemin & "*.xls*")
    'Colonne = n° de colonne ou on va coller les données
    'pour commencer colonne A, laisser à 0, pour commencer colonne B remplacer 0 par 1 etc...
    Colonne = 5
    'on boucle sur tous les fichiers excel du répertoire choisi
    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            'attribue un nom dans le classeur, se référant à la plage à importer : F5:G36
            ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]fiche'!$F$5:$G$36"
            ' "Importe les données" grâce au nom donné ci-dessus
            OI.[F5:G36] = "=Plage"
            OI.[F5:G36].Copy 'Copie F5:G36
            OA.Cells(5, Colonne).PasteSpecial xlPasteValues 'Colle E5:F36
            Colonne = Colonne + 2
        End If
        fichier = Dir()
    Loop
    OA.Range("E5").Select
    OI.Range("F5:G36").ClearContents
End If
End Sub

Le fichier :

9base.xlsm (25.44 Ko)

Invité · Answer

Une petite présentation ICI serait la bienvenue Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum &#91;A LIRE AVANT DE POSTER&#93; qui vous aidera dans vos demandes et réponses sur ce forum Cette méthode fonctionne très bien chez moi, je pense que c'est plus un problème de chemin d'accès Merci de votre participation Cordialement...

ThauThème · Answer

Bonjour le fil, bonjour le forum,

J'ai bien sûr testé avant de t'envoyer car c'est la première fois que je trouve un code qui travaille fichiers fermés et que je réussis à comprendre...

Chez moi je n'ai pas eu d'erreur avec les quatre fichiers que je t'envoie pour que tu puisses tester avec la Base... Peut-être les fichiers n'ont pas d'onglet nommé fiche ?

7fiche-01.xlsx (8.69 Ko)

3fiche-02.xlsx (8.69 Ko)

1fiche-03.xlsx (8.69 Ko)

3fiche-04.xlsx (8.69 Ko)