Change variable result each time used in sub vba

Question

I have code which sorts and copies results from one worksheet to another. Sometimes I need to paste copied range to the next blank cell on selected worksheet, for which I need to use ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row.

        Worksheets("Wallets").AutoFilterMode = False

        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*TRANSFER*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & Worksheets("Wallets").Cells(Rows.Count, 1).End(xlUp).Row).Copy
                 Worksheets("Transfers").Cells(Worksheets("Transfers").Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValue

        Worksheets("Wallets").AutoFilterMode = False

        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*EXCHANGE*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & Worksheets("Wallets").Cells(Rows.Count, 1).End(xlUp).Row).Copy
                 Worksheets("Transfers").Cells(Worksheets("Transfers").Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1, 0)..PasteSpecial Paste:=xlPasteValues

I was thinking about changing code so i can replace this part more easily if I need to use other column for some worksheets for example. Is there any way to make variable recalculate each time it used in sub? Part of code below just saves first result and uses it, but I need to update row count number it for each worksheet which is currently used(perferably without using Worksheets.Select).

Sub Sort_Wallets()
Dim x As Long

       x = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    

        Worksheets("Wallets").AutoFilterMode = False
        Worksheets("Wallets").Select
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*TRANSFER*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & x).Copy
                 Worksheets("Transfers").Select
                 Worksheets("Transfers").Cells(x, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                 

        Worksheets("Wallets").AutoFilterMode = False
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=5, Criteria1:="*EXCHANGE*"
        Worksheets("Wallets").Range("$A$1:$J10000").AutoFilter Field:=7, Criteria1:=">0"
                 Worksheets("Wallets").Range("B2:I" & x).Copy
                 Worksheets("Transfers").Cells(x, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Sub

Answer 1

Assuming you're using your worksheets like data tables, use "tables". For each table of data, highlight it and "Insert Table", and then go into the table ribbon (available only when the cursor is within that table) and change the name of your table from whatever it is ("Table5") to something that makes sense to you.

In VBA, these are called ListObjects. As long as you know the names of these tables, you can get them with the following code:

'Returns the specified object from a collection
'Returns Nothing if the value in the collection doesn't exist.
'Throws no errors
Private Function GetFromCollection(col As Collection, sKey As String) As Object
    On Error Resume Next
    Set GetFromCollection = col.item(sKey)
    Err.Clear
End Function

Public Function GetListObjectFromWorkbook(sTableName As String, Optional bRecache As Boolean = False) As ListObject
    Static bInitialized As Boolean
    Static col As Collection
    Dim lo As ListObject
    Dim sht As Worksheet
    
    If bRecache Or Not bInitialized Then
        Set col = New Collection
        For Each sht In Sheets
            For Each lo In sht.ListObjects
                col.Add lo, lo.Name
            Next lo
        Next sht
        bInitialized = True
    End If
    Set GetListObjectFromWorkbook = GetFromCollection(col, sTableName)
End Function

From there, you don't need to know where the last row is! Adding a new row is:

Dim listrow As ListRow
Set listrow = GetListObjectFromWorkbook(sTableName).ListRows.Add

and you can manipulate the values of that new ListRow via listrow.Range

FYI: You can sort ListObjects, too. See the VB code in https://learn.microsoft.com/en-us/dotnet/api/microsoft.office.tools.excel.listobject.sort?view=vsto-2017

Answer 2

If you are looping through worksheets you can, but not if you are only using two worksheets. You will need to specify the worksheet. You are using x as the last row in each case and I doubt that is true. Why set J10000 if you are going to find the last row? Also, it looks like you only want to copy the visible cells after you filter. You need to specify that you only want the visible cells. It is easier to follow your code if you Set the variables, ranges and worksheets so as not to repeat long lines. Here is an example of what I just said using your code. There may even be a better solution, but this is more readable than what you have.

Sub Sort_Wallets()
    Dim destlr As Long
    Dim sourcelr As Long
    Dim wk1 As Worksheet
    Dim wk2 As Worksheet
    Dim FiltRng As Range
    
    Set wk1 = ThisWorkbook.Worksheets("Wallets")
    Set wk2 = ThisWorkbook.Worksheets("Transfers")
    
    
    destlr = wk2.Cells(Rows.Count, 1).End(xlUp).Row
    sourcelr = wk1.Cells(Rows.Count, 1).End(xlUp).Row
    
    Set FiltRng = wk1.Range(wk1.Cells(1, 1), wk1.Cells(sourcelr, 10))
    
    wk1.AutoFilterMode = False
       
    FiltRng.AutoFilter Field:=5, Criteria1:="*TRANSFER*"
    FiltRng.AutoFilter Field:=7, Criteria1:=">0"
    wk1.Range("B2:I" & sourcelr).SpecialCells(xlCellTypeVisible).Copy

    wk2.Cells(destlr, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
             

    wk1.AutoFilterMode = False
    FiltRng.AutoFilter Field:=5, Criteria1:="*EXCHANGE*"
    FiltRng.AutoFilter Field:=7, Criteria1:=">0"
    wk1.Range("B2:I" & sourcelr).SpecialCells(xlCellTypeVisible).Copy
    
    wk2.Cells(destlr, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
End Sub