VBA autofilter to exclude header

[klimt]

Hi,

What I want to achieve is to copy my selection without the header. Unfortunately I am very new to VBA and I was unable to apply any of the solutions I found to my code, so I am asking your help now.

My code is as follows:

Sub Extract_Data2()
Application.ScreenUpdating = False
 
Set a = ActiveSheet
'Select Range
Range("C5:e240").Select
'Apply Autofilter
Selection.AutoFilter
Selection.AutoFilter field:=1, Criteria1:=">2"
Selection.AutoFilter field:=3, Criteria1:=">0"
Selection.SpecialCells(xlCellTypeVisible).Copy
Sheets("graphs").Activate
Set b = ActiveSheet
Range("a2").Select
'Paste the copied cells
ActiveSheet.Paste
 
Range("a2").Select 'unselect everything
'Go back to the original sheet
Sheets("wind speed for each hour").Activate
'Take the Autofilter off
Selection.AutoFilter
 
End
End Sub

Thanks.

 

[VoG]

Perhaps like this

Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy

 

[klimt]

Wow! Thanks for the quick reply. That is perfectly what I wanted. Now my only problem is that I am using this code for several other ranges, and if a range does not match with the criterias, then the code stops, because there is no selection to resize.

 

[klimt]

I tried using IF to skip the copying bit if there was no selection, but I wasn't sure how to determine that. The code I used still gave me the same error (1004), and marked the Selection.Offset line yellow.

If Selection Is Nothing Then
Sheets("graphs").Activate
Set b = ActiveSheet
Else
Selection.Offset(1).Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
Sheets("graphs").Activate
Set b = ActiveSheet
End If

 

[p45cal]

Try this:

Sub Extract_Data2()
Dim RngToCopy As Range
With Sheets("wind speed for each hour")
    If .FilterMode Then .AutoFilterMode = False    'turns it off if it was active
    .Range("C5:e240").AutoFilter    'turn it on again for that range
    With .AutoFilter.Range
        .AutoFilter field:=1, Criteria1:=">2"
        .AutoFilter field:=3, Criteria1:=">0"
        On Error Resume Next
        Set RngToCopy = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not RngToCopy Is Nothing Then RngToCopy.Copy Sheets("graphs").Range("a2")
    End With
    .AutoFilterMode = False
End With
End Sub

No selecting, activating sheets etc.

 

[klimt]

Wow, thanks p45cal! This is perfectly what I was looking for.

For the record: the only alteration I needed to make was that I changed

If Not RngToCopy Is Nothing Then RngToCopy.Copy Sheets("graphs").[COLOR="Red"]Range("a2")[/COLOR]

to

If Not RngToCopy Is Nothing Then RngToCopy.Copy Sheets("graphs").[COLOR="red"]Range("A65536").End(xlUp).Offset(1, 0)[/COLOR]

so that it would only use blank cells.

Thanks again!