Function Extract_Number_from_Text(Phrase As String) As Double
Dim Length_of_String As Integer
Dim Current_Pos As Integer
Dim Temp As String
Length_of_String = Len(Phrase)
Temp = ""
For Current_Pos = 1 To Length_of_String
If (Mid(Phrase, Current_Pos, 1) = "-") Then
  Temp = Temp & Mid(Phrase, Current_Pos, 1)
End If
If (Mid(Phrase, Current_Pos, 1) = ".") Then
 Temp = Temp & Mid(Phrase, Current_Pos, 1)
End If
If (IsNumeric(Mid(Phrase, Current_Pos, 1))) = True Then
    Temp = Temp & Mid(Phrase, Current_Pos, 1)
 End If
Next Current_Pos
If Len(Temp) = 0 Then
    Extract_Number_from_Text = 0
Else
    Extract_Number_from_Text = CDbl(Temp)
End If
End Function


Sub Копирование2()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim Lastrow&, Lastrow1&, Ws1, Ws2 As Worksheet, i%, n As Variant
Set Ws1 = ThisWorkbook.Worksheets("Список")
Ws1.Calculate
Set Ws2 = Workbooks.Open("C:\Users\Антон\Desktop\Куда вставляем.xlsm").Worksheets("Отработка")


Lastrow = Ws1.Range("D100000").End(xlUp).Row
Lastrow1 = WorksheetFunction.CountIf(Ws2.Range("C:C"), "<>")





For i = 4 To Lastrow

n = Application.Match(Extract_Number_from_Text(Ws1.Range("D" & i)), Ws2.Range("N:N"), 0)
    If IsError(n) = True Then
    
    Ws1.Range("B" & i & ":" & "D" & i).Copy
    Ws2.Range("B" & Lastrow1 + 1).PasteSpecial Paste:=xlPasteValues
    
    Ws1.Range("E" & i & ":" & "E" & i).Copy
    Ws2.Range("L" & Lastrow1 + 1).PasteSpecial Paste:=xlPasteValues
    
    Ws1.Range("F" & i & ":" & "F" & i).Copy
    Ws2.Range("P" & Lastrow1 + 1).PasteSpecial Paste:=xlPasteValues
    
    Ws1.Range("G" & i & ":" & "AM" & i).Copy
    Ws2.Range("R" & Lastrow1 + 1).PasteSpecial Paste:=xlPasteValues
    
    Else
        
    Ws1.Range("F" & i).Copy
    Ws2.Range("P" & n).PasteSpecial Paste:=xlPasteValues
    
    Ws1.Range("G" & i & ":" & "AM" & i).Copy
    Ws2.Range("R" & n).PasteSpecial Paste:=xlPasteValues
    
    End If

Next

Ws2.Activate
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & Lastrow1), Type:=xlFillDefault
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I" & Lastrow1), Type:=xlFillDefault
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M" & Lastrow1), Type:=xlFillDefault
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N" & Lastrow1), Type:=xlFillDefault
Range("Q2").Select
Selection.AutoFill Destination:=Range("Q2:Q" & Lastrow1), Type:=xlFillDefault
Ws2.Calculate


Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Function Replace_format(ByVal txt As String) As String
    St$ = "pdf,doc,xls,zip,rar"
        For i% = 1 To Len(St$) Step 3
        txt = Replace(txt, Mid(St$, i, 3), "." & Mid(St$, i, 3))
        Next
    'txt = Replace(txt, ChrW(774), "")
    Replace_symbols = txt
End Function

<?xml version="1.0" encoding="UTF-8" standalone="true"?>
-<recoveryLog xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main">
<logFileName>error168440_01.xml</logFileName>
<summary>Обнаружены ошибки в файле "Z:\Путь к файлу"</summary>
-<additionalInfo>
<info>Удалена одна или несколько недопустимых формул.</info>
</additionalInfo>
</recoveryLog>

Sub HideCollumns()
Dim objWorkbook As Excel.Workbook
Dim strWorkbookName As String
'С помощью msoFileDialogFilePicker просто помещаем в переменную strWorkbookName имя выбранного файла.
With Application.FileDialog(msoFileDialogFilePicker)
.Show
strWorkbookName = .SelectedItems(1)
End With
'А здесь уже открываем выбранный файл и связываем его с переменной objWorkbook, через которую и будем работать с выбранным файлом.
Set objWorkbook = Workbooks.Open(Filename:=strWorkbookName)
Set sh1 = objWorkbook.Worksheets("123")
Set sh2 = objWorkbook.Worksheets("1234")
With sh1
[C:C,G:G,H:H,I:I,L:L,M:M,N:N,Q:Q,R:R,S:S,T:T,U:U,Z:Z,AF:AF,AJ:AJ,AL:AL,AN:AN,AO:AO,AU:AU,AV:AV,AW:AW,AX:AX,AZ:AZ,BA:BA,BB:BB,BC:BC].Columns.Hidden = True
End With
End Sub

If Not LCase(.Cells(i, "f").Text) Like "*еп*" Then