Found the below code to be working, but have two constrains. Each rows from the source file is copied in the last empty column. The string is gets pasted with double quotes.
Sub ImportCSV()
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Application.ScreenUpdating = False
'Change the path to the source folder accordingly
strSourcePath = "C:\Users\xxxx\Documents\test"
If Right(strSourcePath, 1) <> "" Then strSourcePath = strSourcePath & ""
'Change the path to the destination folder accordingly
strDestPath = "C:\Users\xxxx\Documents\test1"
If Right(strDestPath, 1) <> "" Then strDestPath = strDestPath & ""
strFile = Dir(strSourcePath & "*.csv")
Do While Len(strFile) > 0
Cnt = Cnt + 1
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
Open strSourcePath & strFile For Input As #1
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
Cells(r, c + 1).Value = Trim(x(c))
Next c
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strDestPath & strFile
strFile = Dir
Loop
Application.ScreenUpdating = True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation</code>End Sub Kindly help me to fix this.
Sub ImportCSV()
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Application.ScreenUpdating = False
'Change the path to the source folder accordingly
strSourcePath = "C:\Users\xxxx\Documents\test"
If Right(strSourcePath, 1) <> "" Then strSourcePath = strSourcePath & ""
'Change the path to the destination folder accordingly
strDestPath = "C:\Users\xxxx\Documents\test1"
If Right(strDestPath, 1) <> "" Then strDestPath = strDestPath & ""
strFile = Dir(strSourcePath & "*.csv")
Do While Len(strFile) > 0
Cnt = Cnt + 1
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
Open strSourcePath & strFile For Input As #1
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
Cells(r, c + 1).Value = Trim(x(c))
Next c
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strDestPath & strFile
strFile = Dir
Loop
Application.ScreenUpdating = True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation</code>End Sub Kindly help me to fix this.