Sub New ()
Dim AW As Window
    Dim CellValue As String
   Dim Path As String
   Dim FinalFileName As String
   Path = ThisWorkbook.Path & "\"
   Application.DisplayAlerts = False
       Set AW = ActiveWindow
    For Each s In AW.SelectedSheets
        Set TempWindow = AW.NewWindow
        s.Copy
        TempWindow.Close
   CellValue = Range("N8")
   FinalFileName = Path & CellValue
   ActiveWorkbook.SaveAs Filename:=FinalFileName, _
                      FileFormat:=xlOpenXMLWorkbook
   Application.DisplayAlerts = True
    Next
           For Each ws In ActiveWorkbook.Worksheets
        ws.UsedRange.Value = ws.UsedRange.Value
    Next ws
    End Sub

=@ЕСЛИ(СМЕЩ(T18;-1;0)=T18;нумер(ЕСЛИ(S18="заголовок";1;2));1)

With sh1.UsedRange: End With
iLastRowPerenos = sh1.UsedRange.Row + sh1.UsedRange.Rows.Count - 1

Sub Убрать_ошибку()With Worksheets("ОБЩИЙ").Range("O19:O20")
  .Replace What:="+#REF!", Replacement:=""
  .Replace What:="=#REF!", Replacement:="="
  .Replace What:="=+", Replacement:="="
End With
End Sub

Sub Убрать_ошибку()
Range("O19:O20").Replace What:="+#REF!", Replacement:=""
Range("O19:O20").Replace What:="=#REF!", Replacement:="="
Range("O19:O20").Replace What:="=+", Replacement:="="
End Sub

Sub Sortirovka()
Range("A4:E12").Sort Key1:=Range("D4"), Order1:=xlAscending, Key2:=Range("B4"), Order2:=xlAscending, Key3:=Range("A4"), Order3:=xlAscending, Header:=xlYes
End Sub

Sub Sortirovka()
Range("A4:E12").Sort Key1:=Range("D4"), Order1:=xlAscending, Header:=xlYes
Range("A4:E12").Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlYes
Range("A4:E12").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlYes
End Sub

=ЕСЛИ(МИН(ЕСЛИ((Col_1=A2);Col_2;""))=0;"";МИН(ЕСЛИ((Col_1=A2);Col_2;"")))

Function Replace_symbols(ByVal txt As String) As String
    st$ = "~!@/\#$%^&*|`"""
    For i% = 1 To Len(st$)
        txt = Replace(txt, Mid(st$, i, 1), "-")
    Next
    Replace_symbols = txt
End Function

Sub Find()
MsgBox Range("D21:D157").Find("*яблок*").Row
End Sub

ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

Worksheets(2).Activate
  Range("A1:E14").Calculate
  Range("A1:E28").Activate
     Dim smallrng As Range
     For Each smallrng In Selection.Areas
     smallrng.Value = smallrng.Value
     Next smallrng
  Range("A2").Select
  ActiveWindow.ScrollRow = 1
Worksheets(1).Activate

    With Worksheets(2)
     .Range("A1:E28").Activate
...
    End With.

Set shSource2 = Sheets("Новый лист")
Sheets(Array(shSource.Name, shSource2.Name)).Copy

Sheets(Array(shSource.Name, "Новый лист")).Copy

Sheets(Array(shSource.name, "Новый лист")).Copy

Sub Разбить_по_файлам_ИЗМ()    
Dim oDic As Object, oFSO As Object    
Dim arrData(), arrSeparateItems()    
Dim TempWb As Workbook    
Dim sFolderPath As String, sFullFileName As String    
Dim LastRow As Long, i As Long, n As Long    
Dim RngData As Range, FilteredRng As Range        
If MsgBox("Разбить по файлам?", vbQuestion + vbYesNo, "Вопрос") = vbNo Then Exit Sub        
sFolderPath = ThisWorkbook.Path & "\" 'здесь укажите путь для сохранения файлов      
Application.ScreenUpdating = False       
Set oFSO = CreateObject("Scripting.FileSystemObject")    
Set oDic = CreateObject("Scripting.Dictionary")       
Dim shSource As Worksheet    
Set shSource = ActiveSheet       
Dim Application_Calculation As XlCalculation    
Application_Calculation = Application.Calculation   
Application.Calculation = xlCalculationManual       
With shSource              
If .FilterMode = True Then .ShowAllData        
LastRow = .Cells(.Rows.Count, 12).End(xlUp).Row        
arrData = .Range("T1:T" & LastRow).Value 'столбец, где нужно найти уникальные значения        
Set RngData = .Range("A1").CurrentRegion    
End With       
For i = 21 To UBound(arrData)        
If Not oDic.Exists(arrData(i, 1)) Then oDic.Add arrData(i, 1), 0&    
Next i       
arrSeparateItems() = oDic.Keys       
For n = LBound(arrSeparateItems) To UBound(arrSeparateItems)        
shSource.Copy

 



ХОТЕЛОСЬ БЫ СЮДА СКОПИРОВАТЬ ЕЩЕ ЛИСТ "Новый лист", КОТОРЫЙ СОДЕРЖИТСЯ В ИСХОДНОЙ КНИГЕ      






Set TempWb = ActiveWorkbook 
...ОПРЕДЕЛЕННЫЕ ДЕЙСТВИЯ С ЛИСТОМ, СКОПИРОВАННЫМ В ТЕКУЩУЮ КНИГУ... 
ActiveSheet.name = arrSeparateItems(n)         
sFullFileName = sFolderPath & arrSeparateItems(n) & ".xlsx"        
If oFSO.FileExists(sFullFileName) Then oFSO.Deletefile (sFullFileName)        
TempWb.SaveAs sFullFileName, FileFormat:=xlOpenXMLWorkbook 'XLSX        
TempWb.Close SaveChanges:=False    
Next n       
With ActiveSheet        
If .FilterMode = True Then .ShowAllData    
End With      
Application.Calculation = Application_Calculation    
Application.ScreenUpdating = True    
MsgBox "Файлы сохранены в " & sFolderPath, vbInformation, "Конец"
End Sub

Sheets(Array(Новый лист", ТЕКУЩИЙ ЛИСТ ЗАДАННЫЙ СЕЙЧАС КАК ShSourse)).Copy