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 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
| Sub ImporterFichierTexteFeuille()
Dim chemin As String
Dim monFichier As String
chemin = "M:\Chalandise\Res_pop\"
monFichier = Dir(chemin & "*.TXT", vbNormal)
Dim Wsd, Wbs
Do While monFichier <> ""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & chemin & monFichier, Destination:=Range("A1"))
.Name = monFichier
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(5)
.TextFileFixedColumnWidths = Array(14, 19)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
monFichier = Dir
Loop
End Sub
sinon j'ai essayé le code suivant mais je ne sais pas comment mettre "monFichier" dans la boucle :
Sub ImportTxt()
'Importe tous les fichiers textes contenu dans un répertoire sur des feuilles différentes
Dim chemin As String
Dim monFichier As String
Dim Wsd, Wbs
chemin = "M:\21-Chalandise\Res_pop\"
monFichier = Dir(chemin & "*.TXT", vbNormal)
Do While monFichier <> ""
Set Wsd = ActiveWorkbook.Sheets(1)
Workbooks.OpenText Filename:="M:\Chalandise\Res_pop\Zones.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
Set Wbs = ActiveWorkbook
Wbs.Sheets(1).[A1].CurrentRegion.Copy Wsd.[A1]
Wbs.Close False
monFichier = Dir
Loop
End Sub |
Partager