在空搜索后显示整个表

时间:2016-04-12 14:21:04

标签: excel vba excel-vba

对于下面的代码,如果搜索根据Criteria1:="Ship"显示为空,则无需复制,代码将停在Set rngCopy = Intersect(rngCopy, .Range("A1:H" & lRow), .Range("A1:H" & lRow).Offset(1)).SpecialCells(xlCellTypeVisible),我该如何摆脱此错误?此外,即使没有数据符合标准,我希望整个表格显示。我有一行Worksheets("Efficiency").ShowAllData,但这是假设代码一直运行。

谢谢,

Sub ImportShipper()    
        Dim wsEff As Worksheet
        Dim wsShip As Worksheet
        Dim wsFirst As Worksheet
        Set wsEff = Worksheets("Efficiency")
        Set wsFirst = Worksheets("1")    
        Set wsShip = ActiveSheet
        wsShip.Name = wsFirst.Range("B34").Value     
        With wsEff
            Dim lRow As Long
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A1:H" & lRow).AutoFilter Field:=2, Criteria1:="Ship"
            Dim rngCopy As Range
            'All Columns A:H
            Set rngCopy = .Columns("A:H")
            'filtered rows, not including header row - assumes row 1 is headers
            Set rngCopy = Intersect(rngCopy, .Range("A1:H" & lRow), .Range("A1:H" & lRow).Offset(1)).SpecialCells(xlCellTypeVisible)
            rngCopy.Copy
            End With
        wsShip.Range("A4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Worksheets("Efficiency").ShowAllData
        End Sub

1 个答案:

答案 0 :(得分:0)

你可以这样做

Option Explicit

Sub ImportShipper()
Dim wsEff As Worksheet
Dim wsShip As Worksheet
Dim wsFirst As Worksheet

Set wsEff = Worksheets("Efficiency")
Set wsFirst = Worksheets("1")
Set wsShip = ActiveSheet
wsShip.Name = wsFirst.Range("B34").value
With wsEff
    Dim lRow As Long
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    With .Range("A1:H" & lRow)
        .AutoFilter Field:=2, Criteria1:="Ship"
        With .Offset(1).Resize(.Rows.Count - 1)
            If Application.WorksheetFunction.Subtotal(103, .Columns(2)) > 0 Then
                .SpecialCells(xlCellTypeVisible).Copy
                wsShip.Range("A4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If
        End With
    End With
End With

Worksheets("Efficiency").ShowAllData

End Sub