Прошу прощения, в коде была допущена ошибка...  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  
 
Dim myRange As Range  
Dim rng, FilterData, k, aRange  
   
 Set myRange = Range("G5:G100")  
   
 On Error Resume Next  
       
   
 If Selection.Cells.Count > 1 Then Exit Sub  
   
   If Not Intersect(Target, myRange) Is Nothing Then  
         
       ActiveSheet.AutoFilterMode = False  
   
 'rng = Range("B2")  
   
       k = Target.Value  
   
           Application.ScreenUpdating = False  
 
           FilterData = "=" & k  
               If IsEmpty(FilterData) Then Exit Sub  
           ' Фильтровать  
                   With ActiveSheet  
                       .UsedRange  
                       LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row  
                       Set aRange = Range("G4", Cells(LastRow, "G"))  
                       aRange.AutoFilter Field:=1, Criteria1:=FilterData  
                   End With  
     
           Call copyTo 'вызов макроса копирования был после проверки условия и срабатывал при любом дабл клик...  
     
   End If  
 
 If ActiveCell.Rows.Hidden Then  
   ' Если активная ячейка попала на скрытый ряд - стать ниже последней строки фильтра  
   Cells(rng.Cells(1, 1).Offset(rng.Rows.Count, 0).Row, ActiveCell.Column).Select  
 End If  
   
   
   
 ActiveSheet.AutoFilterMode = False  
 Application.ScreenUpdating = True  
 
End Sub