运行时错误6 - 溢出，变量设置为Long

Question

I am having problem executing the copy+paste for a filtered data. My code does not encounter error if filtered field will have a 0 result or > 1. However, if there's 1 record visible after filter, Runtime error 6 appears. Please see code used below:

Dim wsDue As Worksheet
Dim wsTarget As Worksheet
Dim y As Long
Dim x As Long

x = Range("A65536").End(xlUp).Row

Range("A1").AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues
Set wsDue = Worksheets("Due")
Set wsTarget = Worksheets("Target List Consolidated")
y = wsDue.Range("B" & wsDue.Rows.Count).End(xlUp).Row

If wsDue.Range(wsDue.Cells(2, 2), wsDue.Cells(y, 2)).SpecialCells(xlCellTypeVisible).Count > 1 Then
    wsDue.Range("B2:B" & x).Copy
    wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
Else:
End If

Answer 1

First off, make sure your Excel (aka MS-Office) has all applicable service packs. The problem with a single filtered row being interpreted as all rows was a known bug but it was rectified in subsequent service packs.

You can also apply some 'best practices' code to avoid it happening altogether. The Range.CurrentRegion property can be used to localize the Range.AutoFilter Method . Use progressive With ... End With statements to further isolate the data to be transfered.

Dim wsDue As Worksheet, wsTarget As Worksheet

With Worksheets("Due")
    If .AutoFilterMode Then .AutoFilterMode = False
    'work on the contiguous block of cells radiating out from A1
    With .Cells(1, 1).CurrentRegion
        'apply the AutoFilter
        .AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues
        'shift one row down (off the header row) and resize one less row
        'isolate column B
        With .Offset(1, 1).Resize(.Rows.Count - 1, 1)
            'non-destructive test to see if there are any rows visible
            If CBool(Application.Subtotal(103, .Cells)) Then
                Set wsTarget = Worksheets("Target List Consolidated")
                .Copy
                wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial _
                    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
            End If
        End With
    End With
End With

Answer 2

I figured out another way to work around as a solution. I used the following code instead:

Dim x As Long
Dim wsDue As Worksheet
Dim wsTarget As Worksheet

x = Range("A65536").End(xlUp).Row
Range("A1").AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues
Set wsDue = Worksheets("Due")
Set wsTarget = Worksheets("Target List Consolidated")

If wsDue.Range("B1:B" & x).Offset(1, 0).SpecialCells(xlCellTypeVisible).Count > 1 Then
    wsDue.Range("B1:B" & x).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
Else:
End If

The solution was able to get the result of filter and will copy the desired range excluding the header in Row 1.