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
By Using Go To Special Option One way to copy visible cells only in Excel is by using the Go To Special option from the Home menu. To copy only the visible cells, select the cells you want to copy.
Click Home > Find & Select, and pick Go To Special. Click Visible cells only > OK. Click Copy (or press Ctrl+C). Select the upper-left cell of the paste area and click Paste (or press Ctrl+V).
Specify the destination as part of the .Copy
method:
TargetTable.Range.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Sheet8").Range("A1")
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With