How do I copy a csv Sheet into an excel file without changes

Viewed 71

I've got am csv file which looks as follows

enter image description here

When I select all cells and copy/paste it manually into another excel file the result is the same as the original. Howevever, trying to do the same in VBA gives me the following result.

enter image description here

This is the code I am using.

Sub test()
    Dim arr1 As Object
    Set arr1 = CreateObject("System.Collections.ArrayList")
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    '-----------------------------------------------------------
    Dim FileName As Variant
    FileName = Dir(GetFolder & "\")
    '-----------------------------------------------------------
    While FileName <> ""
        arr1.Add GetFolder & "\" & FileName
        FileName = Dir
    Wend
    '-----------------------------------------------------------
    Set fldr = Nothing
    Dim i As Long
    For i = 0 To arr1.Count - 1
        '-------------------------------------------------------------------
        Dim wkbk As Workbook
        Set wkbk = Workbooks.Open(arr1(i))
        wb1 = wkbk.Name
        Set sht = wkbk.Worksheets(wkbk.Sheets(1).Name)
        wkbk.Sheets(sht.Name).Copy After:=ThisWorkbook.Sheets("START")
        ActiveSheet.Name = "NEW"
'        MsgBox wkbk.Name
'        ThisWorkbook.Sheets.Add.Name = "NEW"
'        wkbk.Sheets(sht.Name).Cells.Copy
'        ThisWorkbook.Sheets("NEW").Cells.Paste
        wkbk.Close False
    Next i
End Sub

Is there a way to get the same result as doing it manually?

1 Answers

Import CSV Files

Option Explicit

Sub importCSV()
    
    Const InitialFolderPath As String = "F:\Test\2021"
    Const FilePattern As String = "*.csv"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    
    Dim FolderPath As String
    If Right(InitialFolderPath, 1) = "\" Then
        FolderPath = InitialFolderPath
    Else
        FolderPath = InitialFolderPath & "\"
    End If
        
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Select"
        .AllowMultiSelect = False
        .InitialFileName = FolderPath
        If .Show = False Then
            MsgBox "You canceled."
            Exit Sub
        End If
        FolderPath = .SelectedItems(1) & "\"
    End With
    
    Dim arl As Object: Set arl = CreateObject("System.Collections.ArrayList")
    Dim FileName As String: FileName = Dir(FolderPath & FilePattern)
    Do While FileName <> ""
        arl.Add FolderPath & FileName
        FileName = Dir
    Loop
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim dws As Worksheet
    Dim shId As Long
    Dim i As Long
    For i = 0 To arl.Count - 1
        Set swb = Workbooks.Open(FileName:=arl(i), Local:=True)
        Set sws = swb.Worksheets(1)
        sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
        Set dws = ActiveSheet
        shId = shId + 1
        On Error GoTo NewSheetError
        dws.Name = "New" & shId
        On Error GoTo 0
        swb.Close False
    Next i
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    Exit Sub
    
NewSheetError:
    shId = shId + 1
    Resume

End Sub
Related