VBA script for copying highest row in table - excel

Question

I have a table with data in a worksheet called 'DL data calculation'. I want to copy the highest row in the table (A21:E21) (after filtering) to (Y3:AC3). The problem I am facing right now is that when I declare the range try to filter, only the A21:E21 row of cells gets copied instead of the highest row. Can someone help me? I entered the script I used underneath.
Sub CopySelectionVisibleRowsEnd()
Dim ws As Worksheet
Dim mySel As Range
Dim lRow As Long
Dim lRowNew As Long
Dim lRowsAdd As Long
Dim myList As ListObject
Dim myListRows As Long
Dim myListCols As Long
Set ws = ActiveSheet
Set mySel = Selection.EntireRow
Set myList = ActiveCell.ListObject
myListRows = myList.Range.Rows.Count
myListCols = myList.Range.Columns.Count
lRow = ws.Cells.Find(What:="*", _
SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, _
LookIn:=xlValues).Row + 1
mySel.SpecialCells(xlCellTypeVisible).Copy
ws.Cells(lRow, 1).PasteSpecial Paste:=xlPasteAll
lRowNew = ws.Cells.Find(What:="*", _
SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, _
LookIn:=xlValues).Row + 1
lRowsAdd = lRowNew - lRow
With myList
.Resize ws.Range(.Range.Resize(myListRows + lRowsAdd, myListCols).Address)
End With
Application.CutCopyMode = False
End Sub

Answer 1

I made some changes to create sample data and working code:
Sub CreateSampleData()
Range("A21") = "F1"
Range("B21") = "F2"
Range("C21") = "F3"
Range("D21") = "F4"
Range("E21") = "F5"
Range("A22:E62") = "=INT(RAND()*1000)"
Range("A22:E62").Copy
Range("A22").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$21:$E$62"), , xlYes).Name = "Table1"
End Sub
Sub CopySelectionVisibleRowsEnd()
Dim ws As Worksheet
Dim mySel As Range
Dim lRow As Long
Dim lRowNew As Long
Dim lRowsAdd As Long
Dim myList As ListObject
Dim myListRows As Long
Dim myListCols As Long
Set ws = ActiveSheet 'Sheets("Tabelle1")
Why do you select this row?
You do want to select the first visible row here?
This line just selects the "EntireRow" of the active selection.
Set mySel = Selection.EntireRow
Let's continue with your code:
Set myList = ActiveCell.ListObject
myListRows = myList.Range.Rows.Count
myListCols = myList.Range.Columns.Count
lRow = ws.Cells.Find(What:="*", _
SearchOrder:=xlRows, _
SearchDirection:=xlNext, _
LookIn:=xlValues).Row + 1
'Here you copy the row of the active cell (if its visible).
'If you select a cell and make it unvisible with the filter
'you select nothing!
'mySel.SpecialCells(xlCellTypeVisible).Copy
'If you select a cell after the filter this can be copied with
'your code - first 5 cells only:
mySel.Range("A1:E1").SpecialCells(xlCellTypeVisible).Copy
' You want to paste to Cell Y3?
'ws.Cells(lRow, 1).PasteSpecial Paste:=xlPasteAll
ws.Range("Y3").PasteSpecial Paste:=xlPasteAll
'what is it that you want to achieve here?
lRowNew = ws.Cells.Find(What:="*", _
SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, _
LookIn:=xlValues).Row + 1
lRowsAdd = lRowNew - lRow
'I have no idea what you want to achieve here:
'With myList
'.Resize ws.Range(.Range.Resize(myListRows + lRowsAdd, myListCols).Address)
'End With
Application.CutCopyMode = False
End Sub
With the changes above at least the code was working.
Whatever row the cursor is manually placed in -> this row gets copied to the range "Y3:AC3"
With the below code I copy the first visible row (col A to E)
of the list existing on the active sheet and paste it to the
range (Y3:AC3).
Sub CopySelectionVisibleRowsEnd_NEW()
Dim myList As ListObject
Set myList = ActiveSheet.ListObjects(1) 'ActiveSheet.ListObjects("Table1")
Set CopyRange = myList.Range.Offset(1).SpecialCells(xlCellTypeVisible).Range("A1:E1")
CopyRange.Copy
Range("Y3").PasteSpecial Paste:=xlPasteAll
'or PasteValues:
'Range("Y3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub