Paste multiple filtered criteria into one sheet without pasting over the original data?

Question

I am having trouble copying filtered data on the criteria range, then pasting it into the P&L Regulated Entities sheet without having the new filtered data paste over the previous filtered data. How can I adjust the code below to ensure that data filtered on 1226 is pasted first, then the data filtered on 1843 is pasted below the data from 1226?

Sheets("P&L").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1226*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("P&L Regulated Entities").Select
Range("A1").Select
Selection.PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False,Transpose:=False


Sheets("P&L").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1843*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("P&L Regulated Entities").Select
ActiveCell.Offset(1).Select
Range("A1").Select
Selection.PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Sheets("P&L").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*865*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("P&L Regulated Entities").Select
ActiveCell.Offset(1).Select
Range("A1").Select
Selection.PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Sheets("P&L").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1223*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("P&L Regulated Entities").Select
ActiveCell.Offset(1).Select
Range("A1").Select
Selection.PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Well you would want to make the Range("A1").Select dynamic by finding the last row that has data and moving down one. See here for methods on finding the last row: http://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba then add 1 to the return of the last row. — Scott Craner, Aug 26 '16 at 15:22
@ScottCraner can you show how I would incorporate that into the code above? — JHags, Aug 26 '16 at 15:25
Also, it's best to [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). A lot of this code can be whittled down to maybe 10 lines max. — BruceWayne, Aug 26 '16 at 15:56

score 0 · Answer 1 · answered Aug 26 '16 at 16:23

I would use this. The With...End With structure allows you to drops the .Select statements. The line like .Range("A" & .Rows.Count).End(xlUp).Offset(1,0) will put the copied data in the first empty row on the Regulated Entities sheet.

With Sheets("P&L")
   .Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1226*"
   .AutoFilter.Range.Copy
End With

With Sheets("P&L Regulated Entities")
    .Range("A1").PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False,Transpose:=False
End With


With Sheets("P&L")
   .Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1843*"
   .AutoFilter.Range.Copy
End With

With Sheets("P&L Regulated Entities")
   .Range("A" & .Rows.Count).End(xlUp).Offset(1,0).PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With


With Sheets("P&L")
   .Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*865*"
   .AutoFilter.Range.Copy
End With

With Sheets("P&L Regulated Entities")
   .Range("A" & .Rows.Count).End(xlUp).Offset(1,0).PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With


With Sheets("P&L")
   .Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1223*"
   .AutoFilter.Range.Copy
End With

With Sheets("P&L Regulated Entities")
   .Range("A" & .Rows.Count).End(xlUp).Offset(1,0).PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

Paste multiple filtered criteria into one sheet without pasting over the original data?

1 Answers1