简体   繁体   English

Excel VBA - 仅复制和粘贴可见表行

[英]Excel VBA - copying and pasting visible table rows only

I am trying to copy only the visible rows in a table into a seperate worksheet in the same workbook. 我试图只将表中的可见行复制到同一工作簿中的单独工作表。 I'm a little new to using the 'ListObject' approach to dealing with tables (for a few reasons, referencing the table directly is a better approach here in terms of the rest of my module) 我使用'ListObject'方法来处理表有点新(出于几个原因,就模块的其余部分而言,直接引用表是一种更好的方法)

Below is my best attempt, when I run it I get 'run-time error '438'' on the 'Sheets("Sheet8").Range("A1").Paste' line, I've been scouring the internet for an hour now trying to figure out what I'm doing wrong, how do I need to re-phrase it so that it pastes the copied data into another sheet/table? 下面是我最好的尝试,当我运行它时,我在'Sheets("Sheet8").Range("A1").Paste'上得到'运行时错误'438' 'Sheets("Sheet8").Range("A1").Paste'线,我一直在网上搜索一小时现在试图找出我做错了什么,我怎么需要重新短语它以便将复制的数据粘贴到另一张表/表中? Any assistance would be appreciated! 任何援助将不胜感激!

Thanks, 谢谢,

Adam 亚当

Private Sub CopyVisibleAreaOfTable(ByVal TableName As String)

Const FN_NAME As String = "CopyVisibleAreaOfTable"
On Error GoTo catch

    Dim TargetTable As ListObject
    Dim NumberOfAreas As Long

    Set TargetTable = Sheets("Adj1").ListObjects(TableName)

    ' Check that there are fewer than 8192 seperate areas
    With TargetTable.ListColumns(1).Range
        NumberOfAreas = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
        Debug.Print NumberOfAreas
    End With

    If NumberOfAreas = 0 Then
        'Do something to trigger an error message
    Else

        TargetTable.Range.SpecialCells(xlCellTypeVisible).Copy
        Sheets("Sheet8").Range("A1").Paste
        Application.CutCopyMode = False

    End If

finally:
    Exit Sub

catch:
    Call ErrorReport(FN_NAME, True, Err.Number, Err.Description, "Table Name: " & TableName)
    Resume finally

End Sub

Specify the destination as part of the .Copy method: 将目标指定为.Copy方法的一部分:

TargetTable.Range.SpecialCells(xlCellTypeVisible).Copy _
    Destination:=Sheets("Sheet8").Range("A1")

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM