sFiles = Dir(sFolder & "*.csv") 'открываем все файлы из папки
    Do While sFiles <> ""         ' пока не кончились файлы
        Set wb = app.Workbooks.Open(sFolder & sFiles)       'открываем файл
        lLastRow = wb.Worksheets(1).UsedRange.Row + wb.Worksheets(1).UsedRange.Rows.Count - 1   'ищем последнюю строку на листе
   
           With wb.Worksheets(1) ' работаем с первым листом в книге
 ' следующая строка вызывает указанную ошибку
                Range("1:1").Select      ' выбираем первую строку экселевского файла
                Selection.Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
                         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                         ReplaceFormat:=False
  ' и заменяем все названия столбцов с пробелом на с подчеркиванием
                
                .Columns("A:A").Select ' выбираем первый столбец
                Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :="|", FieldInfo:=Array(Array(1, 4), Array(2, 4), Array(3, 2), Array(4, 2), Array(5, 2), _
                Array(6, 2), Array(7, 2), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
                , 1), Array(13, 1)), TrailingMinusNumbers:=True
              
' растаскиваем его по столбцам по символу |

            CntRow = "A1:M" & lLastRow  ' формируем диапазон
            DoCmd.TransferSpreadsheet acImport, 10, "import", sFolder + sFiles, True, CntRow   ' вставляем в таблицу import значения диапазона
           End With
           app.DisplayAlerts = False
           wb.Close False
           Set wb = Nothing
        sFiles = Dir
    Loop

With wb.Worksheets(1)
                .Range("1:1").Select
                app.Selection.Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
                         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                         ReplaceFormat:=False
  
                .Columns("A:A").Select
                app.Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :="|", FieldInfo:=Array(Array(1, 4), Array(2, 4), Array(3, 2), Array(4, 2), Array(5, 2), _
                Array(6, 2), Array(7, 2), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
                , 1), Array(13, 1)), TrailingMinusNumbers:=True
              
            lLastRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
            CntRow = "A1:M" & lLastRow
            DoCmd.TransferSpreadsheet acImport, 10, "import", sFolder + sFiles, True, CntRow
End With