VBA to export selected row values of excel to csv - vba

Question

I have a requirement for VBA, wherein, If I select a cell in excel, it will export that entire row values to csv.
I have tried
Sub WriteCSVFile()
Dim My_filenumber As Integer
Dim logSTR As String
My_filenumber = FreeFile
logSTR = logSTR & Cells(1, "A").Value & " , "
logSTR = logSTR & Cells(2, "A").Value & " , "
logSTR = logSTR & Cells(3, "A").Value & " , "
logSTR = logSTR & Cells(4, "A").Value
Open "C:\Users\xxxxx\Desktop\Sample.csv" For Append As #My_filenumber
Print #My_filenumber, logSTR
Close #My_filenumber
End Sub
If the range selection can be made dynamic, it can solve the purpose.

Answer 1

Export Selection Rows to CSV
Sub ExportRowsToCSV()
Const FILE_PATH_RIGHT As String = "\Desktop\Sample.csv"
Const FIRST_CELL_ADDRESS As String = "A2"
Const ColDelimiter As String = "," ' or ";"
Const RowDelimiter As String = vbLf
If ActiveSheet Is Nothing Then Exit Sub ' no visible workbook open
If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
If Not TypeOf Selection Is Range Then Exit Sub ' not a range selected
Dim FilePath As String
FilePath = Environ("USERPROFILE") & FILE_PATH_RIGHT
' or:
'FilePath = Environ("OneDrive") & FILE_PATH_RIGHT
Dim drg As Range: Set drg = Selection
Dim ws As Worksheet: Set ws = drg.Worksheet
Dim srg As Range
With ws.UsedRange
Dim lCell As Range: Set lCell = .Cells(.Rows.Count, .Columns.Count)
Set srg = ws.Range(FIRST_CELL_ADDRESS, lCell)
End With
Dim rg As Range: Set rg = Intersect(srg, drg)
If rg Is Nothing Then Exit Sub
Set rg = Intersect(srg, rg.EntireRow)
If rg Is Nothing Then Exit Sub
Dim dLen As Long: dLen = Len(ColDelimiter)
Dim rString As String
Dim rrg As Range
Dim cell As Range
For Each rrg In rg.Rows
For Each cell In rrg.Cells
rString = rString & CStr(cell.Value) & ColDelimiter
Next cell
rString = Left(rString, Len(rString) - dLen) & RowDelimiter
Next rrg
rString = Left(rString, Len(rString) - Len(RowDelimiter))
Dim TextFile As Long: TextFile = FreeFile
Open FilePath For Append As #TextFile
Print #TextFile, rString
Close #TextFile
MsgBox "Row(s) exported.", vbInformation
End Sub

Answer 2

Here I got the code to copy the "values in the entire row where the cell is active" and paste to csv file.
'''
Sub xlRangeToCSVFile()
Dim myWB As Workbook
Dim rngToSave As Range
Dim fNum As Integer
Dim csvVal As String
Dim i As Integer
Set myWB = ThisWorkbook
csvVal = ""
fNum = FreeFile
Set rngToSave = Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row)
Open "C:\Users\xxxxx\Desktop\Sample.csv" For Output As #fNum
i = 1
For j = 1 To rngToSave.Columns.Count
csvVal = csvVal & Chr(34) & rngToSave(i, j).Value & Chr(34) & ","
Next
Print #fNum, Left(csvVal, Len(csvVal) - 1)
csvVal = ""
Close #fnum
End Sub
'''