Search code examples
excelvbacopy-pasteuserform

VBA script for copying highest row in table


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

Solution

  • 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