Filter and copy to another table with some extras

[jocker_boy]

Hello everyone,

I will try to explain my goal.

Sheet1

Header 1	Header 2	Header 3	Header 4	Header 5
AAA	CCC	EEE	HHH	5
AAA	DDD	FFF	III	9
BBB	DDD	GGG	HHH	10
...	...	...	...	...

Sheet2

Header 1	Header 2	Header 6	Header 7	Header 8	Header 9
Filter 1	Filter 2	TEXT 1	TEXT 2	New / Delete	Number 1, 2, 3, 4....

Sheet3

Header 1	Header 2	Header 3	Header 4	Header 6	Header 7	Header 5=Header 9 (1)	Header 5=Header 9 (2)	Header 5=Header 9 (3)
AAA	CCC	EEE	HHH	TEXT 1	TEXT 2	5
AAA	DDD	FFF	III	TEXT 1	TEXT 2	9
BBB	DDD	GGG	HHH	TEXT 1	TEXT 2	10
...	...	...	...

In Sheet 1 i have my Database, with multiple rows.
In Sheet 2, i choose "Filter 1" and "Filter 2", to filter the table in sheet 1 in "Header 1" and "Header 2".
In Sheet 2 i insert "Text 1", "Text 2", "Number 1" and choose "New or Delete"

If "New" it will sort using "Filter 1" and "Filter 2" and copy the table from "sheet 1" to the table in "sheet 3"

The dificult part is "Header 5" and "Header 9".
In sheet 2, in "Header 9" i will choose a number, "1", or "2", or "3", or more.

If "1" the values from "Header 5" will be copy to "Header 5=Header 9 (1)"
If "2" the values from "Header 5" will be copy to "Header 5=Header 9 (2)"
If "3" the values from "Header 5" will be copy to "Header 5=Header 9 (3)"
and so on...

If "Delete" it will sort using "Filter 1", "Filter 2", "Header 6", "Header 7 and "Header 9"" in table of "sheet 3" and delete those values.

Many thanks to all help.
Sorry to be so "complicated" to explain.

I have already this codes, but it is not perfect:

Sub Filter()
    Dim sistema As Range, tipo As Range
  
    With Worksheets("sheet2")
        Set sistema = .Range("A2")
        Set tipo = .Range("B2")
    End With

    With Worksheets("Sheet1")
        With .Range("A1:I" & getlastrow)
            .AutoFilter 'Turn off any previous filtering
            .AutoFilter field:=1, Criteria1:=sistema
            .AutoFilter field:=2, Criteria1:=tipo
        End With
    End With
          
End Sub

Sub CopyPaste()
  
Set ws = ThisWorkbook.Worksheets("sheet3")
ws.Activate
  
Dim NextRow As Range
Set NextRow = Range("A" & Sheets("sheet3").UsedRange.Rows.Count + 1)
Sheets("Sheet1").Select
    With ActiveSheet.ListObjects("Table1").Range
        .Offset(1, 0).Resize(.Rows.Count - 1).Select
        Selection.Copy
    End With

Sheets("sheet3").Select
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing

End Sub

Sub Location()
    With Sheets("sheet3")
        .Range("E:E").SpecialCells(xlBlanks).Value = Sheets("sheet2").Range("C2").Value
        .Range("F:F").SpecialCells(xlBlanks).Value = Sheets("sheet2").Range("D2").Value
     End With
End Sub

Function getlastrow() As Integer
    Dim i As Integer
    getlastrow = 0
    With Worksheets("Sheet1")
        For i = 0 To 3
            'starting with 2+i=2 (column B) and End with 2+i=5 (column E)
            If (.Cells(.Rows.Count, 2 + i).End(xlUp).Row) > getlastrow Then
                getlastrow = .Cells(.Rows.Count, 2 + i).End(xlUp).Row
            End If
        Next i
    End With
End Function

Sub Delete()

'Apply a filter to a Range and delete visible rows
'Source: https://www.excelcampus.com/vba/delete-rows-cell-values/

Dim ws As Worksheet
Dim sistema As Range, Nome As Range, spot As Range

    With Worksheets("sheet2")
        Set sistema = .Range("A2")
        Set Nome = .Range("B2")
        Set spot = .Range("C2")
        Set other = .Range("D2")
    End With

  'Set reference to the sheet in the workbook.
  Set ws = ThisWorkbook.Worksheets("sheet3")
  ws.Activate 'not required but allows user to view sheet if warning message appears
 
  'Clear any existing filters
  On Error Resume Next
    ws.ShowAllData
  On Error GoTo 0

  '1. Apply Filter
  With Worksheets("sheet3")
        With .Range("A1:J1000")
            .AutoFilter 'Turn off any previous filtering
            .AutoFilter field:=1, Criteria1:=sistema
            .AutoFilter field:=2, Criteria1:=Nome
            .AutoFilter field:=5, Criteria1:=spot
            .AutoFilter field:=6, Criteria1:=other
        End With
    End With
   
      
  '2. Delete Rows
  Application.DisplayAlerts = False
    ws.Range("A2:J1000").SpecialCells(xlCellTypeVisible).Delete
  Application.DisplayAlerts = True
 
  '3. Clear Filter
  On Error Resume Next
    ws.ShowAllData
  On Error GoTo 0

End Sub