Changing the structure of the files

Amended the above for multiple files. Opens a dialogue box for you to select the files in the folder then cycles through and dumps them at the bottom of the table each time. There is no error checking - assumes all the input files are identical.

Sub LoadCSVtoArray()
Dim stFilename() As Variant
Dim stFilenamez As String
Dim a As Integer


stFilename() = Application.GetOpenFilename("Csv Files (*.csv), *.Csv", , "Open the .csv file to merge", , True)
        
For a = 1 To UBound(stFilename())

strfilenamez = Split(stFilename(a), "\")(UBound(Split(stFilename(a), "\")))

strPath = Replace(stFilename(a), strfilenamez, "", 1)

Set cn = CreateObject("ADODB.Connection")
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
cn.Open strcon

strSQL = "transform Sum(Value) SELECT id, Year, Day FROM " & strfilenamez & " GROUP BY id, Year, Day PIVOT Month;"


Dim rs As Recordset
Dim rsARR() As Variant
Dim fldCount As Integer
Dim iCol As Integer
Dim iRow As Integer


Set rs = cn.Execute(strSQL)
rsARR = rs.GetRows

fldCount = rs.Fields.Count

    For iCol = 1 To fldCount
        Range("a1").Cells(1, iCol).Value = rs.Fields(iCol - 1).Name
    Next


rs.Close
Set cn = Nothing

Cells(GetLastRow("Sheet1", "A") + 1, 1).Resize(UBound(rsARR, 2) + 1, UBound(rsARR, 1) + 1).Value = TransposeDim(rsARR)

Next a

End Sub
Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)
    
    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant
    
    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)
    
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X
    
    TransposeDim = tempArray

End Function

Function GetLastRow(strSheet, strColum) As Long

 Dim MyRange As Range
 Dim lngLastRow As Long

    Set MyRange = Worksheets(strSheet).Range(strColum & "1")

    lngLastRow = Cells(1048576, MyRange.Column).End(xlUp).Row
    
    GetLastRow = lngLastRow
    
     Set MyRange = Nothing
 End Function

Could you run it again and when it error hit debug
then type ?strfilenamez
This will then tell you the file it errors out on - could you then post that file? Or rerun excluding that file and see it it gets further? I want to work out if it is a particular file that is the issue

Got the file - replicated the error....working on it. It is the problem I suspected....