Importare ed unire più file CSV in Excel

Sub importData()
Application.ScreenUpdating = False
Dim InputData, rec, l, Freeway, Direction
mFolder = "c:\MiaCartella\" '<<<<<<<<<<<<<<<< CAMBIARE
strFile = Dir(mFolder & "*.csv")
l = 1
Do While strFile <> ""
    Open mFolder & strFile For Input As #1
    Do While Not EOF(1)
        Line Input #1, InputData
            rec = Split(InputData, ",")
            If l = 1 Then
                l = Stampa(rec, l)
            Else
                Freeway = rec(2)
                Direction = rec(3)
                If Freeway >= "805" And Direction = "N" Then
                l = Stampa(rec, Range("A" & Rows.Count).End(xlUp).Row + 1)
                End If
            End If
    Loop
    Close #1
    strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
Function Stampa(records, lineNo)
    Dim i
    For i = 0 To UBound(records)
        ActiveSheet.Cells(lineNo, i + 1) = records(i)
    Next

End Function

Option Explicit

Sub LeggeCopia()
On Error GoTo 10
Application.ScreenUpdating = False
Const Path As String = "C:\prove\AlessandroG90\CSV\"
Dim oExcel As Excel.Application
Dim strFile As String
Dim NRc As Long, NRd As Long
Dim MioFile As String

    NRd = Range("A" & Rows.Count).End(xlUp).Row
        If NRd < 2 Then NRd = 2
            Rows("2:" & NRd).Clear
        NRd = 2
    MioFile = ActiveWorkbook.Name
    
    Set oExcel = New Excel.Application
        strFile = Dir(Path & "*.*")
    Do While strFile <> ""
        Workbooks.Open Filename:=Path & strFile
    Testo
        NRc = 2
    Do While Cells(NRc, 1) <> ""
        If Cells(NRc, 3) = 805 And Cells(NRc, 4) = "N" Then
            NRc = NRc + 1
        Else
            Rows(NRc).Delete
        End If
    Loop
        Rows("2:" & NRc - 1).Copy
    Windows(MioFile).Activate
    Cells(NRd, 1).Select
    ActiveSheet.Paste
    NRd = Range("A" & Rows.Count).End(xlUp).Row + 1
        Application.DisplayAlerts = False
            Workbooks(strFile).Close
            strFile = Dir
    Loop
        Application.DisplayAlerts = True
    oExcel.Quit
10:
    Set oExcel = Nothing
        Application.CutCopyMode = False
Application.ScreenUpdating = True
    Cells(2, 3).Select
End Sub

Sub Testo()
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1)), TrailingMinusNumbers _
        :=True
    Cells.Columns.AutoFit
End Sub