Filter, copy and paste into another sheet

[Mykiej23]

Hi,
I've been creating a macro to filter on column N in the Raw Data tab and then copy and paste columns A-J into the Report Log at the bottom. It works, except theres currently one result with Check in Column N but it is copy and pasting this in twice. Any idea why?

Sub filter()Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
Dim lastRow As String


'specify sheet name in which the data is stored
sht = "Raw Data"


'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "N").End(xlUp).Row
Set rng = Sheets(sht).Range("A2:I" & last)


Sheets(sht).Range("N1:N" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True


For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=14, Criteria1:="Check"
.SpecialCells(xlCellTypeVisible).Copy


    With Sheets("Report Log")
    lastRow = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Row
    .Cells(lastRow, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False


End With
End With
Next
End Sub

Any help would be appreciated.

 

[Fluff]

Try removing the lines in red

Sub filter()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
Dim lastRow As String


'specify sheet name in which the data is stored
sht = "Raw Data"


'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "N").End(xlUp).Row
Set rng = Sheets(sht).Range("A2:I" & last)


[COLOR=#ff0000]Sheets(sht).Range("N1:N" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True


For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))[/COLOR]
With rng
.AutoFilter
.AutoFilter Field:=14, Criteria1:="Check"
.SpecialCells(xlCellTypeVisible).Copy


    With Sheets("Report Log")
    lastRow = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Row
    .Cells(lastRow, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False


End With
End With
[COLOR=#ff0000]Next[/COLOR]
End Sub

 

[Mykiej23]

Try removing the lines in red

Sub filter()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
Dim lastRow As String


'specify sheet name in which the data is stored
sht = "Raw Data"


'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "N").End(xlUp).Row
Set rng = Sheets(sht).Range("A2:I" & last)


[COLOR=#ff0000]Sheets(sht).Range("N1:N" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True


For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))[/COLOR]
With rng
.AutoFilter
.AutoFilter Field:=14, Criteria1:="Check"
.SpecialCells(xlCellTypeVisible).Copy


    With Sheets("Report Log")
    lastRow = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Row
    .Cells(lastRow, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False


End With
End With
[COLOR=#ff0000]Next[/COLOR]
End Sub

That worked perfectly, thank you so much!

 

[Fluff]

You're welcome & thanks for the feedback