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,569
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,569
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Forum statistics

Threads
1,078,504
Messages
5,340,766
Members
399,394
Latest member
farlow

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top