Sub csv_to_txt()
    Dim pathTxt$, temp$, nameTxt$
    Dim rarName$, appWinRar$, str$
    Dim lr&, lc&, i&, j&
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "1"
    Selection.AutoFill Destination:=Range("D1:D3600"), Type:=xlFillDefault
    nameTxt = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
    pathTxt = ActiveWorkbook.Path & "\" & "09" & Format(nameTxt, "000") & ".txt"
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    Open pathTxt For Output As #1
        For i = 1 To lr
            temp = i - 1 & ":"
            For j = 1 To lc
                temp = temp & Cells(i, j) & ";"
            Next j
            Print #1, temp
        Next i
    Close #1
    appWinRar = "C:\Program Files (x86)\WinRAR\WinRAR.exe a -ep1 -df"
    rarName = ActiveWorkbook.Path & "\" & "09" & Format(nameTxt, "000") & ".zip"
    str = appWinRar & " """ & rarName & """ """ & pathTxt & """ "
    Shell str, vbHide
    
    ActiveWindow.Close False
    
End Sub