Sub Вывести_массив()
    Dim var, lr As Long, r As Long, i As Long
    
    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To lr
        var = Cells(i, "A").Value
        If InStr(2, var, Left(var, 1), vbTextCompare) <> 0 Then
            r = r + 1
            Cells(r, "B").Value = var
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Готово!", vbInformation
End Sub

Sub ВставитьНумерацию()
    LastRow = ActiveSheet.usedrange.Row - 1 + ActiveSheet.usedrange.Rows.Count    'определяем размеры таблицы
    Application.ScreenUpdating = False
    For r = 1 To LastRow Step 1
        If Rows(r).Hidden = True Then
        ElseIf Cells(r, 3) = "" Then
            N = 0
        Else
            N = N + 1
            Cells(r, 1) = N
        End If
    Next r
End Sub

Sub Создать_ряды()
    Dim objChart As Chart, objSeries As Series, i As Long
    
    Application.ScreenUpdating = False
    Set objChart = ActiveSheet.ChartObjects(1).Chart
    For i = objChart.FullSeriesCollection.Count To 1 Step -1
        objChart.FullSeriesCollection(i).Delete
    Next i
    For i = 4 To 21
        If Cells(i, "U").Value <> "" And Cells(i, "V").Value <> "" Then
            Set objSeries = objChart.SeriesCollection.NewSeries
            objSeries.Name = Cells(i, "U").Value
            objSeries.XValues = Range(Cells(i, "V")).Columns(1).Address(External:=True)
            objSeries.Values = Range(Cells(i, "V")).Columns(2).Address(External:=True)
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Sub MakeReport()
    Dim r As Long, i As Long, lr As Long
    Dim SheetFrom As Worksheet, SheetTo As Worksheet
    
    Application.ScreenUpdating = False
    Set SheetTo = ThisWorkbook.Worksheets("Лист1")
    'Здесь укажите путь до файла "Данные.xlsx"
    Set SheetFrom = Workbooks.Open(Filename:="C:\Users\User\Desktop\Данные.xlsx", ReadOnly:=True).Worksheets("Заявка")
    lr = SheetFrom.Cells(SheetFrom.Rows.Count, 1).End(xlUp).Row
    r = SheetTo.Cells(SheetTo.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
        r = r + 1
        SheetTo.Cells(r, 1).Value = SheetFrom.Cells(i, 2).Value
        SheetTo.Cells(r, 2).Value = SheetFrom.Cells(i, 1).Value
        SheetTo.Cells(r, 3).Value = SheetFrom.Cells(i, 10).Value
        SheetTo.Cells(r, 6).Value = SheetFrom.Cells(i, 3).Value
        SheetTo.Cells(r, 7).Value = SheetFrom.Cells(i, 9).Value
        SheetTo.Cells(r, 8).Value = SheetFrom.Cells(i, 5).Value
        SheetTo.Cells(r, 9).Value = SheetFrom.Cells(i, 6).Value
        SheetTo.Cells(r, 10).Value = SheetFrom.Cells(i, 12).Value
        SheetTo.Cells(r, 11).Value = SheetFrom.Cells(i, 14).Value
        SheetTo.Cells(r, 12).Value = SheetFrom.Cells(i, 16).Value
        SheetTo.Cells(r, 13).Value = SheetFrom.Cells(i, 15).Value
        SheetTo.Cells(r, 14).Value = SheetFrom.Cells(i, 17).Value
        
        If SheetFrom.Cells(i, 4) = "230" Then
            SheetTo.Cells(r, 5) = "УАСП"
        ElseIf SheetFrom.Cells(i, 4) = "240" Then
            SheetTo.Cells(r, 5) = "УСП"
        End If
    Next i
    SheetFrom.Parent.Close SaveChanges:=False
    Application.ScreenUpdating = True
    MsgBox "Готово!", vbInformation
End Sub

Sub Вставить_из_txt()
    Dim r As Long, var
    
    Application.ScreenUpdating = False
    r = Cells(Rows.Count, "F").End(xlUp).Row + 1
    'Здесь укажите txt-файл
    Open "C:\Users\User\Desktop\1.txt" For Input As #1
    Do While EOF(1) = False
        Line Input #1, var
        Cells(r, "F").Value = var
        r = r + 1
    Loop
    Close #1
    Application.ScreenUpdating = True
End Sub