Ok, let's try
it is assumed that you have a folder with csv files. Save this file (attached) to the folder.
Open the xlsm file and press the green button.
Sub ertert() 'InputFile$, Wsh$, adr$) 'import csv
Dim i&, k&, s$, x, y(), Fold As String, f As String
Application.ScreenUpdating = False
If Right(ThisWorkbook.Path, 1) <> "\" Then Fold = ThisWorkbook.Path & "\" Else Fold = ThisWorkbook.Path
f = Dir(Fold & "*.csv", vbNormal)
With CreateObject("Scripting.FileSystemObject")
Do While f <> ""
s = .OpenTextFile(Fold & f, 1, 0).ReadAll
If s Like "*" & vbCrLf Then s = Left(s, Len(s) - Len(vbCrLf)): x = Split(s, vbCrLf)
ReDim y(1 To UBound(x) / 4, 1 To 7): k = 0
For i = 1 To UBound(x) Step 6
If Val(x(i)) Then
k = k + 1
y(k, 1) = Split(x(i + 1), "|")(1)
y(k, 2) = Split(x(i), "|")(1)
y(k, 3) = Split(x(i), "|")(2)
y(k, 4) = Split(x(i + 2), "|")(2)
y(k, 5) = Split(x(i + 3), "|")(2)
y(k, 6) = Split(x(i + 4), "|")(2)
y(k, 7) = Split(x(i + 5), "|")(2)
End If
Next i
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2).Resize(k, 7) = y()
f = Dir()
Loop
End With
Application.ScreenUpdating = True
End Sub
Bookmarks