Code to filter and copy paste data

Hi Team,

I am using the below code to automatically filter the data and copy the filtered data to new excel.
I got this code from the same forum.

Sub test()
Dim e
Application.ScreenUpdating = False
With Sheets("sheet1").Cells(1).CurrentRegion
.Parent.AutoFilterMode = False
For Each e In Filter(.Parent.[transpose(if(countif(offset(d2:d10000,,,row(1:10000)),d2:d1000)=1,d2:d1000,char(2)))], Chr(2), 0)
.AutoFilter 4, e
.Copy Sheets("sheet2").Cells(1)
Sheets("sheet2").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
ActiveWorkbook.Close
.AutoFilter: Sheets("sheet2").Cells.Clear
Next
End With
Application.ScreenUpdating = False
End Sub

The problem that I am facing now is my source data got changed in such a way that the filter has to be applied in row 3, column 4 instead of row 1.

I tried editing but I am getting errors. I request someone to help me. Sample data with the previous code attached. Column G,H,I are newly added in this sheet.

Please help

Hi Team,

Please help..