Sub TXT()
Dim remplace, ub&, r&, tablo, t, rest$(), p%, n&, trans$()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
remplace = Range("A1:A2", Cells(Rows.Count, 1).End(xlUp))
remplace(2, 1) = [A2].Text 'date formatée
ub = UBound(remplace)
r = 1
With Workbooks.Open(ThisWorkbook.Path & "\Fichier txt.txt").Sheets(1)
tablo = .Range("A1:A2", .Cells(.Rows.Count, 1).End(xlUp))
For Each t In tablo
ReDim Preserve rest(n)
p = InStr(t, "=")
If p And p < Len(t) Then
rest(n) = Left(t, p)
n = n + 1
r = r + 1
ReDim Preserve rest(n)
If r <= ub Then rest(n) = remplace(r, 1) Else rest(n) = Trim(Mid(t, p + 1))
Else
rest(n) = t
End If
n = n + 1
Next
'---transposition---
ReDim trans(n - 1, 0)
For n = 0 To n - 1
trans(n, 0) = rest(n)
Next
.[A1].Resize(n) = trans
.Parent.SaveAs .Parent.Path & "\" & .Parent.Name, xlText
.Parent.Close
End With
End Sub