Using VBA to copy dates from a .csv to a .xlsx switches the day and month

Question

I have a lot of experience with using VBA in Excel but I'm really struggling with something that feels like it should be straight forward:

I have a large number of .csv files and I would like to collate the data into one .xlsx file. The data is a list of dates and time in column A and then corresponding figures in columns B and C. I'm using the code below to open each .csv one at a time, copy the relevant data and paste it into the .xlsx.

The problem is that when I paste the data, Excel is swapping the day and month for days 1 to 12 of the month (e.g. 02/01/2023 becomes 01/02/2023), IT IS EVEN CHANGING THEM IN THE .CSV. I know there can be issues with date formats but the fact that it is changing in the file I am copying FROM has really baffled me.

In an attempt to fix this I am changing the format of my dates column to match that of the .csv (CUSTOM: "dd/mm/yyyy hh:mm") before and after the paste operation, but to no avail. I've also tried a straight copy paste vs pasteValues and it doesn't make any difference. I've also tried looping through each cell in the range and using xlsCell.value = csvCell.value, but I still get the same result.

Here is my code:

Sub collateData()

Dim StrFile As String
Dim wb As Workbook, swb As Workbook
Dim sht As Worksheet
Dim pasteRow As Integer, headerRowCount As Integer, count As Integer

headerRowCount = 8
pasteRow = headerRowCount + 1

Set wb = Workbooks.Open(ThisWorkbook.Path & "/Member ID - LJW6127 - collated.xlsx")

StrFile = Dir("C:\Users\me\OneDrive\Member Id - LJW61Z7\*.csv")

Do While Len(StrFile) > 0

    If Len(StrFile) = 26 Then
        
        Set swb = Workbooks.Open("C:\Users\me\OneDrive\Member Id - LJW61Z7\" & StrFile)
        
        Set sht = swb.Sheets(1)
        
        wb.Sheets("Hourly").Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"
        
        sht.Range("A9:C" & sht.UsedRange.Rows.count).Copy
        wb.Sheets("Hourly").Range("A" & pasteRow).PasteSpecial xlPasteValues
        
        pasteRow = pasteRow + sht.UsedRange.Rows.count - headerRowCount
            
        Application.DisplayAlerts = False
        swb.Close
        Application.DisplayAlerts = True
        
        DoEvents
        
        Application.CutCopyMode = False
    
    End If
    
    StrFile = Dir
    
Loop
        
wb.Sheets("Hourly").Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"

End Sub

Any help would be greatly appreciated, thank you in advance!

Answer 1

Try OpenText method

Option Explicit

Sub collateData()

    Const HDR = 8
    Const CSVFOLDER = "C:\Users\me\OneDrive\Member Id - LJW61Z7\"
    Const TARGET = "Member ID - LJW6127 - collated.xlsx"

    Dim wb As Workbook, rng As Range, ar
    Dim lastRow As Long, n As Long, StrFile As String
    
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & TARGET)
    With wb.Sheets("Hourly")
        .Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"
        Set rng = .Cells(HDR + 1, "A")
    End With
    
    StrFile = Dir(CSVFOLDER & "*.csv")
    Application.ScreenUpdating = False
    Do While Len(StrFile) > 0
    
        If Len(StrFile) = 26 Then
            
            Workbooks.OpenText Filename:=CSVFOLDER & StrFile, Origin:=xlWindows, _
               DataType:=xlDelimited, Comma:=True, local:=True, _
               FieldInfo:=Array(Array(0, 4), Array(1, 1), Array(2, 1))
            
            With ActiveWorkbook.Sheets(1)
                lastRow = .Cells(.Rows.count, "A").End(xlUp).Row
                ' copy to array
                ar = .Range("A" & HDR + 1 & ":C" & lastRow)
                ActiveWorkbook.Close False
            End With
            
            ' update values
            rng.Resize(UBound(ar), UBound(ar, 2)) = ar
            Set rng = rng.Offset(UBound(ar))
            n = n + 1
            
        End If
        StrFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox n & " csv files imported", vbInformation

End Sub