Copying CSV to Excel

[toshi110]

Hi Everyone

I have been using this code to copy data from csv file and merging it to a sheet. However, it has started messing up for some reason. Instead of pasting the data in new row starting from last row, it goes to the last column entry of first row and keep going to the next column (no row breaks). Any help is appreciated, it used to work properly but not anymore!

Here is the code:

strDestPath = Range("G28").Value
    
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Worksheets("Sheet1").Visible = True
Worksheets("Sheet1").Select
    
       
If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"


strFile = Dir(strSourcePath & "*.csv")
    
    Do While Len(strFile) > 0
        Cnt = Cnt + 1
        If Cnt = 1 Then
            r = 1
        Else
            
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        Open strSourcePath & strFile For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
            If Cnt > 1 Then
                Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , strData
            End If
            Do Until EOF(1)
                Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , strData
                x = Split(strData, ",")
                For c = 0 To UBound(x)
                    Cells(r, c + 1).Value = Trim(x(c))
                Next c
                r = r + 1
                
                'Delete old date Data
                Worksheets("Sheet1").Select
                lRow = Cells(Rows.Count, 1).End(xlUp).Row
                date1 = CDate(Worksheets("Sheet1").Cells(2, 2))
                date2 = CDate(Worksheets("Sheet1").Cells(lRow, 2))
    
                If DateDiff("d", date2, date1) > 31 Then
                Range("B1").Select
                ActiveSheet.Range("$A:$AH").AutoFilter Field:=2, Operator:= _
                xlFilterValues, Criteria2:=Array(2, date1)
                Range("B2").Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.EntireRow.Delete
                ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
                ActiveSheet.ShowAllData
                End If
            Loop
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        
        
        
        'Move file to different folder after copying its data
        Name strSourcePath & strFile As strDestPath & strFile
        strFile = Dir
    Loop

 

[ranman256]

it should be a single statement:

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\bob\Documents\Book1.csv", Destination:=Range("$B$17"))
        .CommandType = 0
        .Name = "Book1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With