Attribute VB_Name = "Module1"
Option Explicit
' les clients sont derriere ! et avant :
' les articles sont entre deux : et comportent 12 caracteres
' les désignations sont entre deux :
' les prix entre : et !
'https://forum.excel-pratique.com/excel/fichier-txt-en-excel-184732
Sub loadTarifs()
Dim sLine As String
Dim sepLine As String
Dim numLine As Long
Dim sOut As String
Dim iCnt As Integer, i As Integer
Dim sNomClient As String
Dim sCodeArticle As String
Dim sNomProduit As String
Dim sCodePdt As String
Dim sTarif As String
Dim nLine As String
Dim nLine2 As String
  Dim sArr() As String
  Dim sArrBak2 As String
numLine = 1
'RepeatedCharacter(" ", 9)
sepLine = RepeatedCharacter1("-", 112)
Open Environ("Userprofile") & "\tarifs2021.txt" For Input As #1
Open Environ("Userprofile") & "\tarifs_2021.txt" For Output As #2
ReDim sArr(1)
While Not EOF(1)
Do
  Line Input #1, sLine
  iCnt = 0
   If UBound(sArr) > 1 Then sArrBak2 = sArr(2)
  If InStr(1, sLine, ":") Then
  ReDim sArr(0)
   sArr = Split(sLine, ":")
   For i = LBound(sArr) To UBound(sArr)
     If i <> 2 Then sArr(i) = VBA.Trim(sArr(i)) 'Replace(sArr(i), " ", "")
   Next
   iCnt = 0
   For i = LBound(sArr) To UBound(sArr)
   If Trim(sArr(i)) <> "" And Trim(sArr(i)) <> "!" Then iCnt = iCnt + 1
   Next
   
  End If
  'sArrBak2 = "POLYSTOP 90MHE14 EMBASE ZN NIC"
  If iCnt >= 3 Or sOut <> "" Then
  If nLine = "" Then
  nLine = Trim(Replace(Replace(sLine, "!", ""), ":", ""))
  Else
  nLine2 = Trim(Replace(Replace(sLine, "!", ""), ":", ""))
  End If
  If numLine = 13 Then
    Print #2, sArr(0) & ";" & sArr(1) & ";" & sArr(2) & ";" & "Code produit client;" & sArr(3)
  Else
    If sLine <> "" And UBound(sArr) > 1 Then
    If sArr(2) <> "" Then
    If Mid(sArrBak2, Len(sArrBak2), 1) <> "" Then
      If Len(sArr(0)) > 1 And sArr(0) <> "!             C L I E N T" Then sNomClient = sArr(0)
      If Len(sArr(1)) > 1 And sArr(1) <> "  N. ARTICLE   " Then sCodeArticle = sArr(1)
      If Len(sArr(2)) > 1 And sCodeArticle <> "" And sArr(2) <> "      D E S I G N A T I O N       " Then
         If (iCnt = 1 Or sNomProduit = "") And _
           (Len(sNomProduit) = 0 Or (Len(sNomProduit) >= 30 And Mid(sArrBak2, Len(sArrBak2) - 2, 1) <> " ")) Then
           sNomProduit = Trim(sNomProduit) + Trim(sArr(2))
         Else
           sCodePdt = sArr(2)
        End If
      End If
      If Len(sArr(3)) > 1 Then sTarif = sArr(3)
      sOut = sNomClient & ";" & sCodeArticle & ";" & sNomProduit & ";" & sCodePdt & ";" & sTarif
      If nLine <> "" And nLine2 <> "" And iCnt = 1 And InStr(1, sNomProduit, sCodePdt) = 0 Then
        Print #2, sOut
            sArrBak2 = " ": nLine = "": nLine2 = "": sCodeArticle = "":  sNomProduit = "":  sCodePdt = "": sTarif = ""
      End If
      'sTarif = sArr(3)
    Else
    Print #2, sArr(0) & ";" & sArr(1) & ";" & sArr(2) & ";" & sNomProduit & ";" & sCodePdt & ";" & sArr(3)
    End If
    End If
    End If
  End If
  End If
  numLine = numLine + 1
Loop Until sLine = sepLine Or EOF(1)
'Loop Until sLine = sepLIne Or sLine = "" Or EOF(1)
Wend
Close #1
Close #2
Dim wksSheet
Dim objFileSystemObject
Dim objLine
Dim intCounter
Dim strLine
Set wksSheet = ActiveWorkbook.Sheets.Add
Set objFileSystemObject = CreateObject("Scripting.FilesystemObject")
Set objLine = objFileSystemObject.OpenTextFile(Environ("USERPROFILE") & "\tarifs_2021.txt")

With wksSheet
    intCounter = 1
    Do Until objLine.AtEndOfStream
        strLine = objLine.Readline
        .Cells(intCounter, 1).Value = strLine
        intCounter = intCounter + 1
    Loop
End With

objLine.Close

wksSheet.Columns("A:A").TextToColumns Destination:=wksSheet.Range("A1"), _
    DataType:=xlDelimited, semicolon:=True

End Sub

Function RepeatedCharacter1(ch As String, n_ch As Integer) As String
Dim s As String
Dim cnt
s = ch
cnt = 1
While cnt <> n_ch
  s = s & ch
  cnt = cnt + 1
Wend
RepeatedCharacter1 = s
End Function