Filter, copy and paste into another sheet

Mykiej23

New Member
Joined
Jun 2, 2016
Messages
20
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?

Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
Try removing the lines in red
Code:
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

New Member
Joined
Jun 2, 2016
Messages
20
Try removing the lines in red
Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Forum statistics

Threads
1,077,674
Messages
5,335,605
Members
399,028
Latest member
greyland

Some videos you may like

This Week's Hot Topics

Top