问题描述
我正在尝试将表中的可见行复制到同一工作簿中的单独工作表中。我有一点新的使用'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 - 仅复制和粘贴可见表行的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!