Sub d()
Dim c As Range, Fn$, An$
For Each c In [a2:a5]
    Zipp c.Offset(, 1).Value, c.Value
Next
End Sub
Public Function Zipp(ZipName, FileToZip)
'Zips A File
'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
Dim FSO As Object
Dim oApp As Object
If Dir(ZipName) = "" Then
Open ZipName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ZipName).CopyHere (FileToZip)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(ZipName).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function

Sub d()
Dim c As Range, Fn$, An$
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each c In [a2:a5]
    Call objFSO.CopyFile(c.Value, c.Offset(, 1).Value)   ' copy file as newFile
    Zipp c.Offset(, 2).Value, c.Offset(, 1).Value
    Kill c.Offset(, 1).Value
Next
End Sub

Sub csvToTxt()
    Dim pathTxt$, temp$, nameTxt$
    Dim rarName$, appWinRar$, str$
    Dim lr&, lc&, i&, j&
    nameTxt = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
    pathTxt = ActiveWorkbook.Path & "\" & "092016111" & 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\WinRAR\WinRAR.exe a -ep1 -df"
    rarName = ActiveWorkbook.Path & "\" & "092016111" & Format(nameTxt, "000") & ".zip"
    str = appWinRar & " """ & rarName & """ """ & pathTxt & """ "
    Shell str, vbHide
End Sub

Sub csvToTxt()

    Dim pathTxt$, temp$, nameTxt$

    Dim rarName$, appWinRar$, str$

    Dim lr&, lc&, i&, j&

    Range("D1").Select

    ActiveCell.FormulaR1C1 = "1"

    Selection.AutoFill Destination:=Range("D1:3600"), 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

Sub csvToTxt()
    Application.ScreenUpdating = False
    Dim pathTxt$, temp$
    Dim rarName$, appWinRar$, str$
    Dim lr&, lc&, i&, j&, r&
    Dim wbCsv As Workbook, sh As Worksheet
    Set sh = ThisWorkbook.Sheets(1)
    appWinRar = "C:\Program Files\WinRAR\WinRAR.exe a -ep1 -df"
    With sh
        For r = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            Set wb = Workbooks.Open(.Cells(r, 1))
            pathTxt = .Cells(r, 2)
            With wb.Sheets(1)
                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
                        temp = temp & "1;"
                        Print #1, temp
                    Next i
                Close #1
                rarName = sh.Cells(r, 3)
                str = appWinRar & " """ & rarName & """ """ & pathTxt & """ "
                Shell str, vbHide
            End With
            wb.Close False
        Next r
    End With
    Application.ScreenUpdating = True
End Sub