VBA macro to copy and paste filtered data to new sheet

Question

I am trying to copy filtered data from one sheet to another, but for some reason I get a runtime error 1004 saying "to copy all cells from another worksheet to this worksheet make sure you paste them into the first cell (A1 or R1C1)" I actually don't want the header row copied, so all visible bar that row

What I am wanting is the copied data to be pasted to the first available row in the target sheet. Here is the code I have which filters for certain things, but then falls over on the paste line

Sub BBWin()
'
' BB Win Macro
' This macro will filter BB Win 1 - 8
'
    With ActiveSheet.Range("A1").CurrentRegion
      With .Resize(, .Columns.Count + 1)
         With .Cells(2, .Columns.Count).Resize(.Rows.Count - 1)
            .FormulaR1C1 = "=if(or(rc7={""K.BB_Win_1_2019"",""K.BB_Win_2_2019"",""K.BB_Win_3_2019"",""K.BB_Win_4_2019"",""K.BB_Win_5_2019"",""K.BB_Win_6_2019"",""K.BB_Win_7_2019"",""K.BB_Win_8_2019""}),""X"","""")"
            .Value = .Value
         End With
         .HorizontalAlignment = xlCenter
      End With
        Cells.Select
        Selection.SpecialCells(xlCellTypeVisible).Copy
        Workbooks("Predictology-Reports.xlsx").Sheets("BB Reports").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False
End Sub

Any suggestions as to what is missing to have it work correctly?

=========================================

OK, perhaps I should have tried the question another way, posting the original working macro I was supplied, rather than posting my attempt to rewrite it.

This is basically the same thing as what I posted above, with the formula changed to look for different text, though it also has autofilter settings (which I don't need) and hides columns (which I don't need to do). This is working perfectly for me and does exactly what it is supposed to. I basically tried to duplicate it and remove the unwanted elements, but as you saw, found the error originally indicated. Obviously my limited knowledge caused the initial issue.

Sub Low_Risk()
'
' Low Risk Lays Macro
' This macro will filter for Remove VDW Rank 1, Class, Distance <=1650, # of Runners <=9, Exclude Brighton, Yarmouth, Windsor & Wolverhampton
'
    With ActiveSheet.Range("A1").CurrentRegion
      With .Resize(, .Columns.Count + 1)
         With .Cells(2, .Columns.Count).Resize(.Rows.Count - 1)
            .FormulaR1C1 = "=if(or(rc8={""Brighton"",""Yarmouth"",""Windsor"",""Wolverhampton""}),""X"","""")"
            .Value = .Value
         End With
         .AutoFilter Field:=4, Criteria1:="<=9"
         .AutoFilter Field:=11, Criteria1:="<=1650"
         .AutoFilter .Columns.Count, "<>X"
         .AutoFilter Field:=29, Criteria1:="<>1"
         .HorizontalAlignment = xlCenter
      End With
        .Columns("C:C").EntireColumn.Hidden = True
        .Columns("G:G").EntireColumn.Hidden = True
        .Columns("I:I").EntireColumn.Hidden = True
        .Columns("L:L").EntireColumn.Hidden = True
        .Columns("N:W").EntireColumn.Hidden = True
        .Columns("Y:AB").EntireColumn.Hidden = True
        .Columns("AD:AJ").EntireColumn.Hidden = True
        .Columns("AO:AO").EntireColumn.Hidden = True
        .Columns("AQ:BQ").EntireColumn.Hidden = True
        .Columns("BT:CP").EntireColumn.Hidden = True
        .Parent.AutoFilter.Range.Offset(1).Copy
        Workbooks("New Results File.xlsm").Sheets("Low Risk Lays").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False
End Sub

As indicated, this works absolutely perfectly, nested Withs and all. I can change the original formula so it is looking in the correct column and only for the text I want, but I obviously was not able to successfully remove the autofilter elements and the elements which hide columns without bringing up an error. I assume the removal of the .Parent.AutoFilter.Range.Offset(1).Copy line was the culprit, but wasn't sure how to approach the removal of the unwanted elements.

This original macro was supplied to me in one of the forums and I am loath to alter the formula part which does a good job of looking for the many text elements required to be copied. That was why I only looked to alter the autofilter section and hidden column section

I'm not sure if this helps at all, but it may clarify things a little

cheers and thanks so much for your effort

Answer 1

Cells.Select (with no leading period to tie it to the With block) will select all cells on whatever is the active sheet.

Try this (nested With's confuse me a bit, so removed a couple)

Sub BBWin()
    Dim arr, ws As Worksheet, lc As Long, lr As Long

    arr = Array("K.BB_Win_1_2019", "K.BB_Win_2_2019", "K.BB_Win_3_2019", _
                "K.BB_Win_4_2019", "K.BB_Win_5_2019", "K.BB_Win_6_2019", _
                "K.BB_Win_7_2019", "K.BB_Win_8_2019")

    Set ws = ActiveSheet
    'range from A1 to last column header and last row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    With ws.Range("A1", ws.Cells(lr, lc))
        .HorizontalAlignment = xlCenter
        .AutoFilter Field:=7, Criteria1:=arr, Operator:=xlFilterValues
        .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    End With
      
    Workbooks("Predictology-Reports.xlsx").Sheets("BB Reports") _
          .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
End Sub

Answer 2

Cells.Select selects all sheets cells.

Selection.SpecialCells(xlCellTypeVisible) keeps all cells, since nothing is hidden and everything is visible. You said something about "copy filtered data" but your code does not filter anything...

So, there is not place to paste all cells .

In order to make your code working, replace Cells.Select with .Cells.Select (the dot in front makes it referring to the resized UsedRange). Even if any selection is not necessary...

So, (better) use .cells.SpecialCells(xlCellTypeVisible).Copy ...

Edited :

Your last code needs to only copy the visible cells of the filtered range. So, your code line

.Parent.AutoFilter.Range.Offset(1).Copy

must be replaced by the next one:

.Parent.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Copy

or

.Offset(1).SpecialCells(xlCellTypeVisible).Copy

which refers the processed range (`UsedRange'), starting from the second row.

Answer 3

What I am wanting is the copied data to be pasted to the first available row in the target sheet.

You should define your available row to paste your fillered rows in, or first blank row in the sheet you want the filtered data pasted. Then you will be able to paste your data into that row.

In my example, I'm filtering my datawork (source sheet) sheet by anything in col 24 that contains "P24128" and pasting into "Sheet8" (Target sheet), in my example.

I actually don't want the header row copied, so all visible bar that row

You also didnt want the headers. :)

  Sub CopyFilteredDataSelection10()

  Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("Datawork")
  
  ws.Activate

 'Clear any existing filters
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0

  '1. Apply Filter
   ActiveSheet.Range("A1:ADU5000").AutoFilter Field:=24, Criteria1:="*P24128*" ' "*" & "P24128" & "*" ' im filtering by anything in col 24 that contains "P24128"

  '2. Copy Rows minus the header
    Application.DisplayAlerts = False

   ws.AutoFilter.Range.Copy 'copy the AF first
   
   Set Rng = ws.UsedRange.Offset(1, 0)
   Set Rng = Rng.Resize(Rng.Rows.Count - 1)
   
   Rng.Copy
    
  '3. The Sheet & Where you want to paste the filtered data precisely into Sheet x (Sheet 8 in my example)
  Sheets("Sheet8").Activate
  lr = ThisWorkbook.Worksheets("Sheet8").Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row + 1
  Range("A" & lr).Select
  ActiveSheet.Paste

  Application.DisplayAlerts = True
  
  '4. Clear Filter from original sheet
    On Error Resume Next
    ws.Activate
    ActiveSheet.ShowAllData
    On Error GoTo 0
   End Sub

What does the not-including the headers is this

   ws.AutoFilter.Range.Copy 'copy the AutoFilter first
   Set Rng = ws.UsedRange.Offset(1, 0)
   Set Rng = Rng.Resize(Rng.Rows.Count - 1)
   Rng.Copy

& your target is after you activate the target sheet and find its last row

lr = ThisWorkbook.Worksheets("Sheet8").Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row + 1