Set findT = Worksheets(i).Range("B:D").Find("Текст", , xlValues, xlPart)
...
Set cellcop_2_ = findT.Offset(, 4)
Union(cellcop_2_, cellcop_2_.Offset(, 2), cellcop_2_2, cellcop_2_2.Offset(, 2)).Copy

Rows(i).Insert (xlShiftDown)
Rows(i).Insert (xlShiftUp)

Dim arrP() As String
P = "P20 P44 P64 P83"
arrP = Split(P)

ReDim Preserve arrP(1 To 4)

Sub test()

Dim f
Dim r As ListObject
Dim rr As Range, r1 As Range
Dim cFileName  As String
Dim wb As Workbook, newwb As Workbook, sh As Worksheet, newsh As Worksheet
Dim i As Long, j As Long
        
Application.ScreenUpdating = False
        
Set wb = ActiveWorkbook
Set sh = ActiveSheet
Set r = sh.ListObjects("Таблица1")
Set r1 = r.Range
Set newwb = Workbooks.Add
Set newsh = newwb.Sheets(1)
        
For i = 1 To 2
    f = i * 100 + 20
    cFileName = f & ""
    If sh.Range("M2").Value = "Зима" Then
 
        With r
            Set rr = Union(.ListColumns("sta").DataBodyRange, .ListColumns("P20").DataBodyRange, .ListColumns("Q20").DataBodyRange)
        End With
       
    Else
        newwb.Close savechanges:=False
        MsgBox ("Проверить наименование")
End If
    rr.Copy
    newsh.Cells(1, 1).Select
    ActiveSheet.Paste
    If InStr(1, cFileName, "\") = 0 Then cFileName = wb.Path & "\" & cFileName
             
    Application.DisplayAlerts = False
    newwb.SaveAs Filename:=(cFileName), FileFormat:=xlCSVWindows, CreateBackup:=False, local:=True
    Application.DisplayAlerts = True
    newwb.Close savechanges:=False
Next
End Sub

Sub test()
Dim wh As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
For i = 1 To 2
    m = i +100 
    For Each wh In Worksheets
         If wh.Name = m Then
            Sheets(m).Select
            Cells.Clear
         End If
    Next
    Worksheets.Add().Name = m
    АctiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
Next i
End Sub