Разместить полученные данные по ячейкам

Sub Скругленныйпрямоугольник1_Щелчок()
 
Dim iTempPath$, a, i%
iTempPath = "c:\555\180501.txt" 'адрес где находится текстовый файл
a = Split(CreateObject("Scripting.FileSystemObject").Getfile(iTempPath).OpenasTextStream(1).ReadAll, vbNewLine)
' если заносить в определенные ячейки без некой закономерности.
Range("A1") = a(178)
Range("A2") = a(538)
Range("A3") = a(898)
Range("A4") = a(1258)
 
End Sub

Sub Макрос2()
'
' Макрос2 Макрос
'
 
'
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\Загрузки\3\180501.txt" _
        , Destination:=Range("$A$1"))
        .Name = "180501_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 866
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Su

Sub Forandreyaru()
Workbooks.OpenText Filename:="c:\555\180501.txt", Origin:=437, StartRow:=1, DataType:=xlFixedWidth
End Sub

Sub Скругленныйпрямоугольник1_Щелчок()
Dim iTempPath$, a$()
  iTempPath = "c:\555\180501.txt"              'адрес где находится текстовый файл
  a = Split(CreateObject("Scripting.FileSystemObject").Getfile(iTempPath).OpenasTextStream(1).ReadAll, vbNewLine)
  ' если заносить в определенные ячейки без некой закономерности.
  Worksheets.Add , ActiveSheet                        '"желательно на другом листе"
  Range("A1") = a(178)
  Range("A2") = a(538)
  Range("A3") = a(898)
  Range("A4") = a(1258)
  Range("A1:A4").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 9), Array(2, 1), Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 2), _
    Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 1), Array(13, 1 _
    ), Array(14, 1)), TrailingMinusNumbers:=True
  Columns("B:J").NumberFormat = "General"
  Columns("B:J").Replace What:=".", Replacement:=".", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
End Sub

Sub Скругленныйпрямоугольник1_Щелчок()
 
Dim iTempPath$, a,b, i%
iTempPath = "c:\555\180501.txt" 'адрес где находится текстовый файл
a = Split(CreateObject("Scripting.FileSystemObject").Getfile(iTempPath).OpenasTextStream(1).ReadAll, , vbNewLine)
i = 1
For m = 178 To 1258 Step 360
b = Split(Trim(a(m)))
For j = 0 To UBound(b)
Cells(i, j + 1).Value = b(j)
Next
i = i + 1
Next

Sub Скругленныйпрямоугольник1_Щелчок()
On Error Resume Next
    Dim datAs Date, y As Long, cell As Range
 
    ' задаём стартовую папку
ChDriveLeft(ThisWorkbook.Path, 1): ChDirThisWorkbook.Path
 
' вывод диалогового окна для запроса имени сохраняемого файла
Filename = Application.GetOpenFilename("Text files (*.txt),", , "Открыть файл для обработки", "Load data")
 
' отказ от выбора  файла - отменяем загрузку данных
If VarType(Filename) = vbBoolean Then Exit Sub

Sub Скругленныйпрямоугольник1_Щелчок()
Dim y1 As Long, y As Long, x, Filename, fso As Object, a$()
  On Error Resume Next
 
  ' задаём стартовую папку
  ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path
 
  ' вывод диалогового окна для запроса имени сохраняемого файла
  Filename = Application.GetOpenFilename("Text files (*.txt),", , "Открыть файл для обработки", "Load data", True)
 
  ' если пользователь отказался от выбора  файла - отменяем загрузку данных
  If VarType(Filename) = vbBoolean Then Exit Sub
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  With Worksheets("Лист2")
    y = .Cells(.Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(.Cells(y, 1)) Then y = y + 1
    y1 = y
    For Each x In Filename
      a = Split(fso.OpenTextFile(x).ReadAll, vbNewLine)
      .Cells(y, 2).Resize(8).Value = WorksheetFunction.Transpose( _
          Array(a(180), a(360), a(538), a(720), a(900), a(1080), a(1260), a(1440)))
      .Cells(y, 1).Resize(8).Value = CDate(a(0))
      y = y + 8
    Next
    With .Range("B" & y1 & ":B" & y)
      .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 9), Array(2, 1), Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 2), _
        Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 1), Array(13, 1 _
        ), Array(14, 1)), TrailingMinusNumbers:=True
      .Copy
      .Offset(, -1).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
      .Delete xlShiftToLeft
    End With
    With .Range("B" & y1 & ":J" & y)
      .NumberFormat = "General"
      .Replace What:=".", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With
  End With
End Sub