Ouvrir .txt dans nouvel onglet en VBA Excel

Version imprimable

Bonjour à tous,

Je souhaiterais ouvrir dans excel 21 fichiers .txt (appelés texte1.txt , texte2.txt, ... , texte21.txt) contenus dans un même dossier à l'aide d'une macro. Le truc c'est que j'aimerais les ouvrir en tant que nouveaux onglets et non comme nouveaux classeurs. Étant donné que je n'ai pas trouvé le moyen d'ouvrir un fichier directement dans un nouvel onglet, je suis passé par une technique qui ouvre le fichier, copie la première feuille dans mon classeur et referme le fichier dont je n'ai plus besoin; le tout dans une boucle qui tourne 21 fois.

Voyez plutôt:
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 32 Sub MAP() ' ' ouverture_txt Macro ' ' Touche de raccourci du clavier: Ctrl+Maj+O ' Dim numero As Integer Dim chemin_dossier As String chemin_dossier = InputBox(Prompt:="Insérez le chemin du dossier où se trouvent les .txt") For numero = 1 To 21 Workbooks.OpenText Filename:= _ 'ouvre le fichier chemin_dossier & "\texte" & numero & ".txt" _ 'chemin\texte1.txt , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _ 'parametres douverture :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _ False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", _ FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 'Sheets.Add After:=Sheets(Sheets.Count) 'ouvre un nouvel onglet, a priori pas necessaire car la copie en creer un directement Windows("texte" & numero & ".xlsx").Activate 'change de fenetre active Sheets("Feuil1").Select 'selectionne la premiere feuille Sheets("Feuil1").Copy Before:=Workbooks("Classeur1").Sheets(1) 'copie cette feuille dans lautre classeur ActiveWindow.Close 'ferme le classeur dont on vient de copier la premiere feuille Next numero 'incremente le compteur End Sub
Mon problème est que, lors de l'exécution, le fichier texte1.txt s'ouvre bien mais dans une nouvelle fenêtre, la copie ne se fait donc pas; et le message d'erreur suivant apparait :

Citation:

Erreur d'exécution ' 9' :
L'indice n'appartient pas à la sélection.

La plupart des lignes de code que j'utilise viennent directement de l'éditeur de macro (j'ai enregistré une macro dont j'ai ensuite copié le code) donc il est censé être bon.
J'ai aussi vu que l'erreur d'exécution 9 pouvait être réglée en ajoutant 'With ThisWorkBook' et 'End With' mais vu que je change de classeur actif et que j'en ferme un, je ne sais pas trop où les placer...

Si quelqu'un pouvait m'aider à voir des erreurs ou trouver des idées de solutions, ça serait vraiment cool!
Merci à tous ceux qui pourront m'aider !

Bonjour,
Hier j'ai répondu à une question comme celle-ci.
J'ai utilisé deux codes de la FAQ, le premier boucle sur tous les fichiers txt d'un répertoire et ouvre le second code qui importe les données du ficher txt.

j'ai modifié le code pour qu'il ajoute une nouvelle feuille, lui donne le nom du txt et importe les données.
Adapte le à tes besoins:

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Dim Chemin As String, Fichier As String
Dim lig As Integer
 
Sub BoucleFichiers()
 
    'Définit le répertoire contenant les fichiers
    Chemin = "C:\test\"
 
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*.txt")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
    'Fichier = Dir(Chemin & "*.*")
 
    'parcours chaque fichier du répertoire
    Do While Len(Fichier) > 0
 
        'appelle la macro pour copier les données
        Call importFichierTexte_ADO
 
        Fichier = Dir()
    Loop
End Sub
 
Sub importFichierTexte_ADO()
    Dim Rc As ADODB.Recordset
    Dim cn As String
    Dim i As Long
 
Rem**************************************************************
    'Nécessite d'activer la référence
        'Microsoft ActiveX Data Objects 2.x Library
Rem**************************************************************
 
    cn = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt"
 
 
    'requête de sélection des données
    myreq = "SELECT * FROM " & Fichier
 
    'connection au fichier txt
    Set Rc = New ADODB.Recordset
    Rc.Open Source:=myreq, ActiveConnection:=cn
 
    'insère une feuille et lui donne le nom du fichier txt
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Left(Fichier, Len(Fichier) - 4)
 
    'copie du fichier txt dans ma nouvelle feuille
    If Not Rc.EOF Then
        For i = 0 To Rc.Fields.Count - 1 'recuperation entetes la 1ere ligne di txt est considérée comme un en-tête
           ActiveSheet.Cells(lig, 1) = Rc.Fields(i).Name
        Next
           ActiveSheet.Range("A2").CopyFromRecordset Rc
    End If
 
    Rc.Close
End Sub

Attention comme écrit dans le code il faut activer: Microsoft ActiveX Data Objects 2.x Library
dans l'éditeur VBA:
cliquer sur Outils => Références...=> cocher Microsoft ActiveX Data Objects 2.x Library (ou x correspond à la version installée)

04/07/2013, 10h40
hazerti

J'ai réussi à faire tout ce que je voulais, merci beaucoup !!