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

Tim Williams · Accepted Answer · 2020-07-20T23:23:31.513

2

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

edited Jul 20 '20 at 23:23

answered Jul 19 '20 at 05:16

Tim Williams

154,628
8
97
125

You need rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy to give the op the selection without the header. – David Wooley - AST Jul 19 '20 at 22:03
1

@SpyrosTzortzis - thanks I missed that piece of the post. – Tim Williams Jul 19 '20 at 22:08
Cheers @Tim-Williams Unfortunately that that appears to either not filter for the required text, or it copies everything, as what is pasted is every entry in the source sheet. – honkin Jul 20 '20 at 06:13
When I posted my code your question contained no filtering, so I assumed it was already filtered. – Tim Williams Jul 20 '20 at 07:02
Added some filtering – Tim Williams Jul 20 '20 at 07:28
cheers @Tim-Williams. This works really well, so thank you very much. One question, to save time, I found it necessary to move a column to stand apart from the others (saves doing it in the target sheet), which leaves 5 blank columns between. Now the macro copies only to the first blank column and misses the lone column (L). Is there a way for that to be included? cheers – honkin Jul 20 '20 at 22:57
Nailed it. Thanks so much @Ted-Williams. That works absolutely perfectly. Just a real time saver. Ta – honkin Jul 22 '20 at 03:41
@honkin: When somebody spends some time and deliver a useful solution, we here vote the code up and more important, tick the code left side check box, in order to make it **accepted answer*. In this way somebody else searching for a similar issue will know which code works as expected... :) – FaneDuru Jul 22 '20 at 07:43
...or don't call me Ted ;-) – Tim Williams Jul 22 '20 at 15:56
Have now done so FaneDuru. Yikes, what was I thinking @Tim-Williams. Early morning and bleary eyes. I do very much appreciate the response and sincere apologies for the basic error. Take care – honkin Jul 23 '20 at 08:39
No problem - happens – Tim Williams Jul 23 '20 at 15:04

FaneDuru · Answer 2 · 2020-07-20T07:49:17.463

1

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.

edited Jul 20 '20 at 07:49

answered Jul 19 '20 at 05:13

FaneDuru

38,298
4
19
27

Cheers @FaneDuru My term filtered data may not be the correct one to use, but the formula at the top of the macro looks for 8 specific cells of text, K.BB_Win_1_2019 and so on. Only rows which have the required text in column 7 should be copied and pasted. – honkin Jul 20 '20 at 06:43
@honkin: This changes a little your code meaning... But not much. Range `Parent` returns the worksheet object. In order to obtain what you need, it would be enough to be sure that only the visible cells of processed `UsedRange` would be copied. It is not place here for code. I will try editing my answer and place a piece of code able to solve your problem. At least, this is what I think... :) – FaneDuru Jul 20 '20 at 07:12

David Wooley - AST · Answer 3 · 2020-07-19T14:36:33.040

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

VBA macro to copy and paste filtered data to new sheet

3 Answers3

Linked