помести этот код в модуль листа
текстовые файлы должны находится в той же папки что и этот файл
при вводе в ячейку "A1" имени файла например: "35-85.txt"
данные занесутся на лист начиная с ячейки "А3"
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
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
