[XL-2007] Erreur d'exécution '-2147024809 (80070057)' [Résolu]

[lecter85]

Bonjour,

J'ai fais une macro qui pour chaque fichier .txt dans un dossier, l'importe dans un fichier Excel dans une feuille dont le nom correspond au nom du fichier (sans l'extension .txt).

Voici mon code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub test()

    Dim objBO, objrep
          
    'déclaration des variables
    repertoire = "\\magnum\suivi_des_operations$\ESPR\Etudes\BDD\BRUT"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objDossier = objFSO.GetFolder(repertoire)

    'pour chaque fichier ".rep" dans le dossier
    If (objDossier.Files.Count > 0) Then
        For Each objFichier In objDossier.Files
            If (InStr(1, objFichier.Name, ".txt", 1) > 0) Then
    
                'nom de la feuille = nom du fichier
                nom_feuille = Left(Right(objFichier.Name, Len(objFichier.Name) - Len(Left(objFichier.Name, 6))) _
                , Len(Right(objFichier.Name, Len(objFichier.Name) - Len(Left(objFichier.Name, 6)))) _
                - Len(Right(Right(objFichier.Name, Len(objFichier.Name) - Len(Left(objFichier.Name, 6))), 4)))
                                
                'importe le fichier texte dans la feuille correspondante
                With Workbooks("BDD.xlsm").Sheets(nom_feuille).QueryTables.Add(Connection:= _
                    "TEXT;" & repertoire & "\" & objFichier.Name _
                    , Destination:=Range("$A$1"))
                    .RefreshStyle = xlOverwriteCells
                    .Refresh BackgroundQuery:=False
                End With    
            End If
        Next
    End If

End Sub

Quand je lance la macro, j'ai une

Erreur d'exécution '-2147024809 (80070057)': La plage de destination n'est pas dans la même feuille de calcul que celle dans laquelle la table de requête est créée.

Je ne vois pas ce qui cloche dans mon code. Quelqu'un a-t-il une idée s'il vous plait ?

Merci par avance.

[Theze]

Bonjour,

Si tu veux récupérer juste le nom du fichier sans l'extension et dans sa totalité, utilise plutôt ceci :

Code :

1
2
 
nom_feuille = Left(objFichier.Name, Len(objFichier.Name) - 4)

car ceci estropie le nom si il dépasse 11 caractères :

Code :

1
2
3
4
 
        nom_feuille = Left(Right(objFichier.Name, Len(objFichier.Name) - Len(Left(objFichier.Name, 6))) _
, Len(Right(objFichier.Name, Len(objFichier.Name) - Len(Left(objFichier.Name, 6)))) _
- Len(Right(Right(objFichier.Name, Len(objFichier.Name) - Len(Left(objFichier.Name, 6))), 4)))

Hervé.

[lecter85]

En fait j'ai fait comme ça car le nom de mes fichiers n'est pas exactement le même que celui de mes feuilles.

Mes fichiers se nomment :
BDD - Appels sortants.txt
BDD - Convention.txt
...

Et mes feuilles se nomment :
Appels sortants
Convention
...

Du coup c'est le seule moyen que j'ai trouvé pour extraire la correspondance.

Pour mon erreur j'ai trouvé d'où ça venait :

Code :

1
2
3
4
5
                With Workbooks("BDD.xlsm").Sheets(nom_feuille).QueryTables.Add(Connection:= _
                    "TEXT;" & repertoire & "\" & objFichier.Name _
                    , Destination:=Workbooks("BDD.xlsm").Sheets(nom_feuille).Range("$A$1"))
                    .RefreshStyle = xlOverwriteCells
                    .Refresh BackgroundQuery:=False

Il fallait rajouter la partie en gras.

Maintenant j'ai un autre problème. Je souhaite supprimer les données de chaque feuille avant d'importer. J'ai fait ce code qui efface les données de chaque colonne non vide de la feuille (quand la cellule de la première ligne est non vide) :

Code :

1
2
3
4
5
6
7
8
                Sheets(nom_feuille).Select
                i = 1
 
                Do While Cells(1, i) <> "" Or Cells(1, i).Interior.Color <> 49407
                    Columns(i).Select
                    Selection.ClearContents
                    i = i + 1
                Loop

Mais il tourne en boucle. Je ne vois pas pourquoi.

[Theze]

Re,

Avec And plutôt non ?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
 
I = 1
 
'boucle tant que la cellule en cours n'est pas vide
'et que sa couleur est différente de 49407
Do While Cells(1, I) <> "" And Cells(1, I).Interior.Color <> 49407
 
    Columns(I).ClearContents
    I = I + 1
 
Loop
 
Hervé.

[lecter85]

C'est ça !

Olala c'est tellement évident, comment j'ai fais pour passer à côté... on va dire que c'est bientôt le week end lol.

Merci en tout cas !