Vba кто знает - поправить екселевский макрос

[mr.Faster]

исходник

Sub ÇàãðóçèòüÈçÔàéëà()
On Error GoTo Err_F

ActiveSheet.Unprotect
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
theFilter = "Òåêñò.ôàéëû (*.*),*.*"
myfile = Application.GetOpenFilename(theFilter, 1, "Âûáåðèòå ôàéë ñ îò÷åòîì ÎÑÁ")

If myfile = "Ëîæü" Then Exit Sub


Set o = ActiveSheet
o.Range("A10:m5000").Select

    '//ñòèðàåì îøèáêè è êîììåíòàðèè
     Selection.Interior.ColorIndex = xlNone
     If o.Comments.Count > 0 Then
     Selection.ClearComments
     End If

Selection.ClearContents

 

 Workbooks.OpenText FileName:=myfile, Origin:=xlWindows, _
       StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
       ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
       , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 4 _
       ), Array(2, 2), Array(3, 1), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), _
       Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 4), Array(13, 4), Array(14, 2), Array(15, 2))
    
   ActiveSheet.Range(Cells(1, 3), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).Select
   Selection.Copy
   
   n_str = Selection.Rows.Count
   n_wind = ActiveWorkbook.Name
   
   ThisWorkbook.Activate
   
   
   o.Range("A10").Select
       Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
   
      
   
   o.Range("Äàòà").Value = Workbooks(n_wind).Sheets(1).Cells(1, 1).Value
   o.Range("Áàíê").Value = Áàíê(Workbooks(n_wind).Sheets(1).Cells(1, 2).Value)
   o.Range("Îòäåëåíèå").Value = Workbooks(n_wind).Sheets(1).Cells(1, 4).Value

   
   o.Cells(10 + n_str, 1).Formula = "Êîíåö"
   o.Cells(1, 10).Select
   
   
     For Each i In Range(Cells(10, 1), Cells(10 + n_str - 1, 13))
        If i.Column = 9 Or i.Column = 12 Or i.Column = 13 Then
           If GetDecimalDelimiter = "," Then
           '÷òîáû âîñïðèíèìàëîñü êàê ÷èñëî
           i.Replace ".", "."
           End If
        i.Value = CDbl(i.Value)
        End If
     Next i
  
   
ActiveSheet.PageSetup.PrintArea = Range(Cells(2, 1), Cells(10 + n_str, 13)).Address

ActiveSheet.Protect

Windows(n_wind).Activate
ActiveWindow.Close
ThisWorkbook.Activate
'    Workbooks(n_wind).Close ' (savechanges = False)
 

 
 MsgBox "Çàãðóæåíî", vbOKOnly
 
Exit Sub
Err_F:
 MsgBox Err.Description, vbCritical
Resume Next

End Sub

что делает - грузит файл формата

data1|data1|data1 (string)

распихивает по нужным ячейкам

нужно грузить пачку файлов

либо

по одному, пересортировывая по мере подгрузки новых файлов

сейчас новый файл затирает предыдущие данные.

кто возьмется - координаты, цену - в личку

[Grimm]

89033212848

поподробнее цель и сам файл на anshakov_vasilii@mail.ru