Public Sub ImportTxt()
Dim myFso As Object, txtFile As Object
Dim pathFichierTxt As String, tmpTab() As String, i As Long, j As Long
pathFichierTxt = "E:\aMiki\XLS\test\test.txt"
Set myFso = CreateObject("Scripting.FileSystemObject")
Set txtFile = myFso.OpenTextFile(pathFichierTxt, 1)
'sauter la première ligne
txtFile.ReadLine
'boucler sur toutes les lignes restantes
While Not txtFile.AtEndOfStream
i = i + 1
tmpTab = Split(NettoyerEspaces(txtFile.ReadLine), " ")
If i Mod 3 = 1 Then
For j = LBound(tmpTab) To UBound(tmpTab)
Range("A" & Int(i / 3) + 1).Offset(0, j).Value = CDbl(Replace(tmpTab(j), ".", ","))
Next j
ElseIf i Mod 3 = 2 Then
For j = LBound(tmpTab) To UBound(tmpTab)
Range("A" & Int(i / 3) + 1).Offset(0, 5 + j).Value = CDbl(Replace(tmpTab(j), ".", ","))
Next j
Else
For j = LBound(tmpTab) To UBound(tmpTab)
Range("A" & Int(i / 3)).Offset(0, 10 + j).Value = CDbl(Replace(tmpTab(j), ".", ","))
Next j
End If
Wend
txtFile.Close
Set txtFile = Nothing: Set myFso = Nothing
End Sub
'efface les multiples espaces dans une chaine de caractère
Private Function NettoyerEspaces(texte As String) As String
While InStr(texte, " ")
texte = Replace(texte, " ", " ")
Wend
If Right(texte, 1) = " " Then texte = Left(texte, Len(texte) - 1)
If Left(texte, 1) = " " Then texte = Right(texte, Len(texte) - 1)
NettoyerEspaces = texte
End Function