Sub Transpose4()
    Const sFull = "C:\tmp\Книга2 (1).csv"

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    'Set fso = New FileSystemObject
    Dim txtIn As Object
    Set txtIn = fso.OpenTextFile(sFull, 1)
    Dim txtOu As Object
    Set txtOu = fso.CreateTextFile(Left(sFull, Len(sFull) - 4) & fso.GetTempName() & ".csv")
    
    Dim i As Byte
    i = 0
    Do
        If txtIn.AtEndOfStream Then Exit Do
        txtOu.Write txtIn.ReadLine
        i = i + 1
        If i = 4 Then
            txtOu.Write vbCrLf
            i = 0
        Else
            txtOu.Write vbTab
        End If
    Loop
    txtIn.Close
    txtOu.Close
End Sub