Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ImpRng As Range
    Dim Filename As String
    Dim r As Long
    Dim c As Integer
    Dim txt As String
    Dim Char As String *  1 
    Dim Impt
    If Target.Address <> "$A$1" Then Exit Sub ' проверка ввода данных в "А1"
    Set ImpRng = ActiveSheet.Cells( 3 ,  1 ) 'ячейка откуда начнут вставлятся данные
    Filename = Left(ThisWorkbook.fullname, Len(ThisWorkbook.fullname) - Len(ThisWorkbook.name)) & _
        cells( 1 , 1 ).value 'путь к текущему файлу + имя файла из ячейки "А1"
    If Dir(Filename, vbNormal) = "" Then 'проверка существования файла
        MsgBox "Фаил " & cells( 1 , 1 ).value & " был удалён или перемещён.", vbCritical
        Exit Sub
    End If
    r =  0 
    c =  0 
    txt = ""
    Open Filename For Input As # 1  'открытие файла
        Do Until EOF( 1 )
            Line Input # 1 , Impt 'считывание строки
            For i =  1  To Len(Impt)
                Char = Mid(Impt, i,  1 )
                If Char = "," Then 'разделитель между значениями
                    ImpRng.Offset(r, c) = txt 'вставка данных
                    c = c +  1 
                    txt = ""
                ElseIf i = Len(Impt) Then 'проверка конца строки
                    If Char <> Chr( 34 ) Then txt = txt & Char
                    ImpRng.Offset(r, c) = txt 'вставка данных
                    txt = ""
                ElseIf Char <> Chr( 34 ) Then
                    txt = txt & Char
                End If
            Next i
            c =  0 
            r = r +  1 
        Loop
    Close # 1 
End Sub

MsgBox ActiveCell.Row