Importation d'un fichier texte

Sub aa()
Dim S As Worksheet
Dim R As Range
Dim var
Dim NbCol&
Dim i&
Dim j&
Dim cpt&
Dim Pos&
Dim T()
Dim A$
'---
Set S = Sheets("order_export")
Set R = S.Range("a1").CurrentRegion
R.Copy
Sheets.Add
Set S = ActiveSheet
S.Paste
'---
Set R = Selection
R.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
  Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
  TrailingMinusNumbers:=True
'---
NbCol& = S.UsedRange.Columns.Count
Set R = R.Offset(0, 1)
R.Cut Destination:=R.Offset(0, NbCol& - 1)
'---
Set R = S.Range(S.Cells(1, NbCol& + 1), S.Cells(R.Rows.Count, NbCol& + 1))
R.TextToColumns Destination:=R.Cells(1, 1), DataType:=xlDelimited, _
  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
  Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
  TrailingMinusNumbers:=True
'---
Columns(2).Delete Shift:=xlToLeft
'######################################

Set R = S.[a1].CurrentRegion
var = R
'---
On Error Resume Next
For i& = 2 To UBound(var, 1) 'on saute la ligne des titres
  For j& = 5 To UBound(var, 2)
    If (j& - 2) Mod 3 = 0 Then
      A$ = Trim(var(i&, j&))
      If A$ = "" Then Exit For
      cpt& = cpt& + 1
      '--- Coordonnées client ---
      ReDim Preserve T(1 To 9, 1 To cpt&)
      T(1, cpt&) = var(i&, 1)
      T(2, cpt&) = var(i&, 3)
      T(3, cpt&) = var(i&, 4)
      '--- Quantité ---
      A$ = Trim(var(i&, j&))
      Pos& = InStr(1, A$, " ")
      T(4, cpt&) = Mid(A$, 1, InStr(1, A$, Pos& - 1))
      '--- Visuel ---
      A$ = Mid(A$, Pos& + 1)
      Pos& = InStr(1, A$, "(")
      T(5, cpt&) = Mid(A$, 1, Pos& - 1)
      '--- Type ---
      A$ = Mid(A$, Pos& + 1)
      Pos& = InStr(1, A$, " Color ") + Len(" Color ")
      A$ = Mid(A$, Pos&)
      Pos& = InStrRev(A$, ": ")
      T(6, cpt&) = Mid(A$, 1, Pos& - 1)
      '--- Couleur ---
      T(7, cpt&) = Mid(A$, Pos& + 2)
    ElseIf (j& - 3) Mod 3 = 0 Then
      '--- Taille ---
      A$ = Trim(var(i&, j&))
      Pos& = InStrRev(A$, ": ")
      T(8, cpt&) = A$ 'Mid(A$, Pos& + 2)
    ElseIf (j& - 4) Mod 3 = 0 Then
      '--- Packaging ---
      A$ = Trim(var(i&, j&))
      Pos& = InStrRev(A$, ": ")
      A$ = Mid(A$, Pos& + 2)
      Pos& = InStr(A$, " ")
      T(9, cpt&) = Mid(A$, 1, Pos& - 1)
    End If
  Next j&
Next i&
'--- Inscription ---
S.Cells.ClearContents
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 2), UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
R.EntireColumn.AutoFit
End Sub