VBA - using autofilter copy and paste filtered values without heading

jwoo89

New Member
Joined
Jan 5, 2021
Messages
32
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I am working on this macro where I autofilter for certain values.

When I try to select it is including the header. Can someone assist?
VBA Code:
Sub Purchase()
Dim LR As Long
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row

Sheets("MM_ACCT_AMT").Select
      Range("A1").Select
    Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$20").AutoFilter Field:=2, Criteria1:=">0"
Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("BUY_Jrnl").Select
    Range("D4").PasteSpecial Paste:=xlPasteValues

Any help would be appreciated!!! 

Thank you!
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Hello Jwoo,

Change the B1 in this part of your code:-

VBA Code:
Range("B1:B" & LastRow)

to B2

If you upload a sample of your workbook, we could make this more efficient for you. We just need to see how your data is set out.

Cheerio,
vcoolio
 
Upvote 0
Try this:

VBA Code:
Option Explicit
Sub Purchase_V2()

    With Worksheets("MM_ACCT_AMT").Cells(1, 1).CurrentRegion
        .AutoFilter 2, ">0"
        .Offset(1, 1).Resize(.Rows.Count - 1, 1).Copy
            Worksheets("BUY_Jrnl").Range("D4").PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        .AutoFilter
    End With

End Sub
 
Upvote 0
Solution
Hello Jwoo,

Change the B1 in this part of your code:-

VBA Code:
Range("B1:B" & LastRow)

to B2

If you upload a sample of your workbook, we could make this more efficient for you. We just need to see how your data is set out.

Cheerio,
vcoolio

vcoolio - thanks for your help but it looks like it did not work. As it is still pulling the header row

VBA Code:
Sub MMKTRedemption()
Dim LR As Long
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row


Sheets("MM_ACCT_AMT").Select

Range("B2:B22").Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C2").FormulaArray = "=B2*-1"
 Range("C2").AutoFill Range("C2:C20" & Range("A" & Rows.Count).End(xlUp).Row)

Range("A2:C20").Sort Key1:=Range("B2"), Order1:=xlAscending


Sheets("MM_ACCT_AMT").Select
      Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$C$20").AutoFilter Field:=2, Criteria1:="<0"
   
    Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("D4").PasteSpecial Paste:=xlPasteValues
   
Sheets("MM_ACCT_AMT").Select
 Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("E4").PasteSpecial Paste:=xlPasteValues
   
   
   
Sheets("MM_ACCT_AMT").Select
 Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("A4").PasteSpecial Paste:=xlPasteValues

Range("B4").Select
ActiveCell.Value2 = "margin"
Range("B4").AutoFill Range("B4:B" & Range("D" & Rows.Count).End(xlUp).Row)




Sheets("MM_ACCT_AMT").Select
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("D4").End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
Sheets("MM_ACCT_AMT").Select
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("E4").End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Upvote 0
Try this:

VBA Code:
Option Explicit
Sub Purchase_V2()

    With Worksheets("MM_ACCT_AMT").Cells(1, 1).CurrentRegion
        .AutoFilter 2, ">0"
        .Offset(1, 1).Resize(.Rows.Count - 1, 1).Copy
            Worksheets("BUY_Jrnl").Range("D4").PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        .AutoFilter
    End With

End Sub
will try this! as i have multiple of those. and still pulling in headers. here is the vba

VBA Code:
Sub MMKTRedemption()
Dim LR As Long
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row


Sheets("MM_ACCT_AMT").Select

Range("B2:B22").Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C2").FormulaArray = "=B2*-1"
 Range("C2").AutoFill Range("C2:C20" & Range("A" & Rows.Count).End(xlUp).Row)

Range("A2:C20").Sort Key1:=Range("B2"), Order1:=xlAscending


Sheets("MM_ACCT_AMT").Select
      Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$C$20").AutoFilter Field:=2, Criteria1:="<0"
   
    Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("D4").PasteSpecial Paste:=xlPasteValues
   
Sheets("MM_ACCT_AMT").Select
 Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("E4").PasteSpecial Paste:=xlPasteValues
   
   
   
Sheets("MM_ACCT_AMT").Select
 Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("A4").PasteSpecial Paste:=xlPasteValues

Range("B4").Select
ActiveCell.Value2 = "margin"
Range("B4").AutoFill Range("B4:B" & Range("D" & Rows.Count).End(xlUp).Row)




Sheets("MM_ACCT_AMT").Select
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("D4").End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
Sheets("MM_ACCT_AMT").Select
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("E4").End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Upvote 0
vcoolio - thanks for your help but it looks like it did not work. As it is still pulling the header row

VBA Code:
Sub MMKTRedemption()
Dim LR As Long
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row


Sheets("MM_ACCT_AMT").Select

Range("B2:B22").Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C2").FormulaArray = "=B2*-1"
 Range("C2").AutoFill Range("C2:C20" & Range("A" & Rows.Count).End(xlUp).Row)

Range("A2:C20").Sort Key1:=Range("B2"), Order1:=xlAscending


Sheets("MM_ACCT_AMT").Select
      Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$C$20").AutoFilter Field:=2, Criteria1:="<0"
  
    Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("D4").PasteSpecial Paste:=xlPasteValues
  
Sheets("MM_ACCT_AMT").Select
 Range("B1:B" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("E4").PasteSpecial Paste:=xlPasteValues
  
  
  
Sheets("MM_ACCT_AMT").Select
 Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("A4").PasteSpecial Paste:=xlPasteValues

Range("B4").Select
ActiveCell.Value2 = "margin"
Range("B4").AutoFill Range("B4:B" & Range("D" & Rows.Count).End(xlUp).Row)




Sheets("MM_ACCT_AMT").Select
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("D4").End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
Sheets("MM_ACCT_AMT").Select
 Range("C1:C" & LastRow).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("MMKT_SELL_Jrnl").Select
    Range("E4").End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Actually this worked! had to adjust some things - appreciate your help!!!
 
Upvote 0
Good to know that you've sorted it out. Thanks for letting us know.

Cheerio,
vcoolio.
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,261
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top