Ouvrir, copier/coller, fermer

[Tial]

Bonjour à toute et tous.

Je cherche automatiser la manip suivante dans un classeur excel:

Je voudrais ouvrir un répertoire contenant des fichier .txt afin de copier des valeurs dans mon classeur.


Exemple: Dans mon répertoire "MesFichiers", j'ouvre le premier fichier .txt.
Je copie mes valeurs.
Je colle ces valeurs dans mon classeur (feuille2 colone A).
Je ferme le fichier .txt.

Dans mon répertoire "MesFichiers", j'ouvre le second fichier .txt.
Je copie mes valeurs.
Je colle ces valeurs dans mon classeur (feuille2 colone B).
Je ferme le fichier .txt.

Dans mon répertoire "MesFichiers", j'ouvre le trosième fichier .txt.
Je copie mes valeurs.
Je colle ces valeurs dans mon classeur (feuille2 colone C).
Je ferme le fichier .txt ......

Je précise que le nombre de fichiers .txt est variable.

Par avance, un grand merci.
Tial

 

[Nanard]

bonjour Tial, le forum,

Utilise l'enregistreur de macro

@+
Nanard

 

[Temjeh]

Salut Trial

Je ne suis pas très bon avec des loopes donc ceux qui le peuvent la feront
J'avais des codes que j'ai mis ensemble du mieux que j'ai pu:
Voici donc un début avec inputbox (en attendant loope)tu y insère le nom de ton fichier texte et le tout se fait(bien sûr refait les chemins ou sont les fichiers et ton classeur maître):

Function FileExists(FileName As String) As Boolean
FileExists = Dir(FileName) <> ""
End Function

Sub Open()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Nom_Fichier As String
Nom_Fichier = Application.InputBox(prompt:="Entrez le nom du territoir à ouvrir")

ChDir "C:\Documents and Settings\Claude\Bureau"

If FileExists("C:\Documents and Settings\Claude\Bureau\" & Nom_Fichier & ".txt") = False Then
MsgBox "Fichier Inexistant"
GoTo Fin
Else

Workbooks.OpenText FileName:= _
"C:\Documents and Settings\Claude\Bureau\" & Nom_Fichier & ".txt", Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Range("A1:A100").Select
Selection.Copy
Windows("monclasseur").Activate
ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


End If
Windows(Nom_Fichier & ".txt").Activate
ActiveWindow.Close
Fin:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



A++

Temjeh: