Save the results of merged cells to a new csv file

Question

I made a question regarding a cell merge per row. I received a good answer here : First Question

Now, I am using the code as it is in the first question and in addition I use the code from this question : Second Question

My target is to save the results of the merged cells, to a new csv file.

Combining the code from the two I have this :

    Sub sisk()
    Dim sisk As String
    Dim row As Long
    Dim col As Long
    Dim Rng As Range
    Dim WorkRng As Range
    Dim xFile As Variant
    Dim xFileString As String

    For row = 2 To 96
        sisk = vbNullString
        For col = 1 To 4
            If VBA.Len(sisk) Then sisk = sisk & ","
            sisk = sisk & Cells(row, col)
        Next col

        Worksheets("Sheet1").Cells(row, 7) = sisk

    Next row

    xTitleId = "Please select range to be exported"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Application.ActiveSheet.Copy
    Application.ActiveSheet.Cells.Clear
    WorkRng.Copy Application.ActiveSheet.Range("A1")
    Set xFile = CreateObject("Scripting.FileSystemObject")
    ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False 
End Sub

Instead of doing all this, how can I adjust the code? I only need to export the results of the merged cells to a new .csv file. Instead of doing that :

  Worksheets("Sheet1").Cells(row, 6) = sisk

I would like the results (sisk) to be automatically saved in a new CSV file.

Answer 1

How's this:

Sub sisk()
Dim sisk    As String, xFileString As String, xTitleId As String, pathName As String
Dim row     As Long, col As Long
Dim Rng     As Range, WorkRng As Range
Dim xFile   As Variant
Dim my_File As Integer

'pathName = Application.ActiveWorkbook.Path
pathName = "C:\Users\[USER NAME]\Desktop"
my_File = FreeFile

Open pathName & "\Range.csv" For Output Lock Write As #my_File

' Use the next line for headers, if wanted
Print #my_File, "Header1" & "," & "Header2"

For row = 2 To 96
    sisk = vbNullString
    For col = 1 To 4
        If VBA.Len(sisk) Then sisk = sisk & ","
        sisk = sisk & Cells(row, col)
    Next col

    Worksheets("Sheet1").Cells(row, 7) = sisk
    Print #my_File, sisk

Next row

xTitleId = "Please select range to be exported"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
WorkRng.Copy Application.ActiveSheet.Range("A1")
'Set xFile = CreateObject("Scripting.FileSystemObject")
'ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False

Close my_File
End Sub

I'm not sure if they're pasting where you want, but let me know what to tweak and I can!

Be sure to change the pathName to match your path. This also will create (or use, if exists) the Range.csv file, so I commented out the final .SaveAs lines.