循环中的VBA滤波循环

我找到了这段代码，只需一列就可以找到所有唯一的值，并对它们进行过滤，复制/粘贴名为sheet的过滤值

但我需要做的是过滤两列，并用相同的原则命名，所以我修改了它

不知何故，在第一个循环中的第二个值上，它不会在另一个循环中启动循环

为什么它在第二个循环中给我空白

Sub datu_sagrupesana()
Dim x As Range, y As Range, rng As Range, last As Long, sht As Worksheet

Application.ScreenUpdating = False


'datu vieta
Set sht = ThisWorkbook.Worksheets("Test")

'apgabals

last = sht.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sht.Range("A1:C" & last)

sht.Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True 'produkta filtrs
sht.Range("C1:C" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True 'valodas filtrs

For Each y In Range([J2], Cells(Rows.Count, "J").End(xlUp))

For Each x In Range([H2], Cells(Rows.Count, "H").End(xlUp))

With rng
.AutoFilter
.AutoFilter Field:=3, Criteria1:=y.Value
.AutoFilter Field:=1, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy

Sheets.Add(After:=Sheets(Sheets.Count)).Name = y.Value & x.Value
ActiveSheet.Paste
End With

Next x
Next y


'nonemt filtru
sht.AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub

我自己解决

Sub datu_sagrupesana()
Dim x As Long, y As Range, rng As Range, last As Long, sht As Worksheet

Application.ScreenUpdating = False


'datu vieta
Set sht = ThisWorkbook.Worksheets("Test")

'apgabals

last = sht.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sht.Range("A1:C" & last)

sht.Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True 'produkta filtrs
sht.Range("C1:C" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("I1"), Unique:=True 'valodas filtrs

pr = Application.WorksheetFunction.CountA(sht.Columns("H"))
va = Application.WorksheetFunction.CountA(sht.Columns("I"))

For j = 2 To va
For i = 2 To pr
valoda = sht.Cells(j, "I").Value
produkts = sht.Cells(i, "H").Value


'
'For Each y In Range("J2", Cells(Rows.Count, "J").End(xlUp))
'
'
'For Each x In Range("H2", Cells(Rows.Count, "H").End(xlUp))
'
With rng
.AutoFilter
.AutoFilter Field:=3, Criteria1:=valoda
.AutoFilter Field:=1, Criteria1:=produkts
.SpecialCells(xlCellTypeVisible).Copy

Sheets.Add(After:=Sheets(Sheets.Count)).Name = valoda & produkts
ActiveSheet.Paste
End With
'
'Next x
'Next y
Next i
Next j


'nonemt filtru
sht.AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub