Excel VBA - 仅复制和粘贴可见表行 [英] Excel VBA - copying and pasting visible table rows only

问题描述

我正在尝试将表中的可见行复制到同一工作簿中的单独工作表中。我有一点新的使用'ListObject'方法处理表（由于几个原因，直接引用表是一个更好的方法，在这里我的模块的其余部分）

下面是我最好的尝试，当我运行它时，我得到'code''表格（Sheet8）。范围（A1）上的运行时错误438。粘贴'线，我一直在冲浪一个小时，现在试图弄清楚我在做错什么，我需要如何重新排序，以便将复制的数据粘贴到另一张表/表？谢谢，

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 
 
设置TargetTable = Sheets（Adj1）。ListObjects（TableName）
 
'检查那里小于8192个独立区域
带有TargetTable.ListColumns（1）.Range 
 NumberOfAreas = .SpecialCells（xlCellTypeVisible）.Areas（1）.Cells.Count 
 Debug.Print NumberOfAreas 
结束
 
如果NumberOfAreas = 0然后
'做某事触发错误消息
 Else 
 
 TargetTable.Range.SpecialCells（xlCellTypeVisible）。复制
表单（Sheet8）。范围（A1）。粘贴
 Application.CutCopyMode = False 
 
如果
 
 finally：
退出Sub 
 
 catch：
调用ErrorReport（FN_NAME，True，Err.Number，Err.Description，Table Name：& TableName）
最终恢复
 
 End Sub 
  

解决方案

将目的地指定为 .Copy 方法的一部分：

 code> TargetTable.Range.SpecialCells（xlCellTypeVisible）.Copy _ 
 Destination：= Sheets（Sheet8）。Range（A1）
  

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)

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? 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:

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

这篇关于Excel VBA - 仅复制和粘贴可见表行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！