create new sheet in excel using existing macro

Question

I have an Excel sheet having 600 000 records and when I apply the macro, records get reduced to 15k. How within the macro in can put all these 15k records in a new excel sheet?

The macro:

Sub DeleteRecord()
 ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 32
    Dim MySheet As String
MySheet = ActiveSheet.Name


    ActiveSheet.Cells(1, 1).CurrentRegion.AutoFilter Field:=33, Criteria1:= _
    ">=-.09", Operator:=xlAnd, Criteria2:="<=.01"
      Dim cnt As Long
    cnt = Worksheets(MySheet).Cells.SpecialCells(xlCellTypeLastCell).Row

   ActiveSheet.Range("A2", ActiveCell.SpecialCells(xlLastCell)).Select
     If cnt > 3 Then
   Selection.EntireRow.Delete
End If
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 30
   ActiveSheet.Cells(1, 1).CurrentRegion.AutoFilter Field:=33
  ' Range("Claims[[#Headers],[Change in Calculated Contribution]]").Select
  Cells(1, 33).Select
    Selection.AutoFilter
End Sub

Answer 1

Please, test the next code. It also sort your resulted range after filtering. If not needed, you can comment that code part. I use an array to copy the content without using much resources (in case of a big range). If you also need to copy the range format, you/we can use Copy - Paste:

Sub testFilterCopyNewSheet()
   Dim sh As Worksheet, rng As Range, cnt As Long, newSh As Worksheet
    Set sh = ActiveSheet
    If sh.AutoFilterMode Then sh.Cells.AutoFilter
    Set rng = sh.Cells(1, 1).CurrentRegion
    rng.AutoFilter field:=33, Criteria1:= _
                    ">=-.09", Operator:=xlAnd, Criteria2:="<=.01"

        cnt = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row:
        If cnt > 3 Then
            sh.Range("A2", ActiveCell.SpecialCells(xlLastCell)).EntireRow.Delete
        End If
   If sh.AutoFilterMode Then sh.Cells.AutoFilter
   Set rng = sh.Cells(1, 1).CurrentRegion
    rng.Sort key1:=sh.Cells(1, 33), order1:=xlAscending, Header:=xlYes
    Set newSh = Worksheets.aDD(After:=Worksheets(Worksheets.count))
     Dim arrSh As Variant
     arrSh = sh.Range("A1").CurrentRegion.value
     newSh.Range("A1").Resize(UBound(arrSh, 1), UBound(arrSh, 2)).value = arrSh
End Sub

Please, confirm that it does what you need. Tested on some tenth of rows.

Edited: Updated version, able to work on a huge range having a listObject (the filter is eliminated in a different way)...

Please test the next code:

Sub testFilterCopyNewSheet()
   Dim sh As Worksheet, rng As Range, cnt As Long, newSh As Worksheet
    Set sh = ActiveSheet
    sh.ListObjects(1).Range.AutoFilter
    Set rng = sh.Cells(1, 1).CurrentRegion
    rng.Sort key1:=sh.Cells(1, 33), order1:=xlAscending, Header:=xlYes
    rng.AutoFilter field:=33, Criteria1:= _
                    ">=-0.09", Operator:=xlAnd, Criteria2:="<=0.01"

        cnt = sh.Cells.SpecialCells(xlCellTypeLastCell).Row:

        If cnt > 3 Then
            Application.EnableEvents = False
            Application.Calculation = xlCalculationManual
            Application.ScreenUpdating = False
            sh.Range("A2", ActiveCell.SpecialCells(xlLastCell)).EntireRow.Delete
        End If
            Application.EnableEvents = True
            Application.Calculation = xlCalculationAutomatic
            Application.ScreenUpdating = True

   sh.ListObjects(1).Range.AutoFilter
   Set rng = sh.Cells(1, 1).CurrentRegion

    Set newSh = Worksheets.aDD(After:=Worksheets(Worksheets.count))
     Dim arrSh As Variant
     arrSh = sh.Range("A1").CurrentRegion.value
     With newSh.Range("A1").Resize(UBound(arrSh, 1), UBound(arrSh, 2))
        .value = arrSh
        .EntireColumn.AutoFit
    End With
End Sub

If you need the data in the new sheet to have the initial order (sorting), it also can be done. I can insert another column after the last existing, increment there a variable starting from 1 to the last row and finally resort the resulted range filtering on this column and then delete it.

If you need to play with the code, in order to see what filtering criteria are the best, the newly created sheet can be named (let us say: 'Result') and the code will previously search for it. If it exists it clears its content, if not, it creates a new one...

Answer 2

'create new sheet
    Sheets("ScheduleTemplate").Copy After:=Worksheets(Worksheets.Count)
    Sheets("ScheduleTemplate (2)").Visible = True
    Sheets("ScheduleTemplate (2)").Select
    Sheets("ScheduleTemplate (2)").Name = NewName