Feeling good but...help with last row

So I've finally been able (after several days of searching) to come up with and modify VBA code that will look for "Y" in column Q of three worksheets and copy the entire row to another worksheet ("!!").

My problem is with z = 3000

I'm trying to reduce the amount of processing it takes to find the data I want and make this code the simplest I can.

I've looked and tried several examples but can not get a last row search, instead of specifying the last row as 3000. Eventually I will have to search more than 3000 rows for the information I want.

Any help is appreciated.

My code:

Sub Test()
   Dim i as Integer
   Dim j as Integer
   Dim cal (1 to 3) As String
       cal (1) =  "Incident Data"
       cal (2) = "Change Data"
       cal (3) =  "Task Data"

   Dim x as Integer
   Dim y as Integer
   Dim z as Integer

y = 17
z = 3000

j = 2

For x = 1 to 3
For i = 2 to z

   If Sheets(cal(x)).Cells(i,y) = "Y" Then
        Sheets(cal(x)).Select
        Range (Sheets(cal(x)).Cells(i.1), Sheets(cal(x)).Cells(i,17)).Select
        Selection.Copy
        Application.Goto ActiveWorkbook.Sheets("!!").Cells(j,1)
        ActiveSheet.Paste
Else
    j = j -1
    End If
    j = j +1
Next i
Next x

End Sub

Code Tags Added
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(I have added them for you today. Please read all Forum Rules and comply in the future.)

Change

 z=3000

to

 z = Range("A" & Rows.Count).End(xlUp).Row

and on closer look, I think you need to move it to right after your line of code

For x = 1 to 3

Maybe:

Option Explicit

Sub Test()
Dim sSht, lLR As Long, lNR As Long, cell As Range

Dim shTarget As Worksheet: Set shTarget = Sheets("Sheet1")
Dim cal
cal = Array("Incident Data", "Change Data", "Task Data")

Application.ScreenUpdating = False
For Each sSht In cal
    With Sheets(sSht)
        lLR = .Range("Q" & .Rows.Count).End(xlUp).Row
        For Each cell In .Range("Q17:Q" & lLR)
            If cell.Value = "Y" Then
                With shTarget
                    lNR = .Range("Q" & .Rows.Count).End(xlUp).Offset(1, 0).Row
                End With
                cell.EntireRow.Copy _
                    shTarget.Range("A" & lNR)
            End If
        Next cell
    End With
Next 'cell
Application.ScreenUpdating = True
End Sub

Amazed you didn't get asked to change the thread title but I guess "help with last row" covers it.


Regards, TMS

You're welcome. Thanks for the rep.