Copy some columns from the same row, from all worksheets to the start sheet (first) if it meets the criteria

Question

I am doing a project where I need to find the variable in column Q of all worksheets valor procurado, and, if found this criterion, I need to copy the columns from L to Q of that row to the start sheet.

I tried two different ways. At first the error occurs on the line of set i:

    Sub CopiarProgrameAqui()
    Dim i As Range
    Dim primeiraLinha As Integer
    Dim linhaDestino As Integer
        linhaDestino = 1
    Dim plan As Object
    Dim valorProcurado As Double
        valorProcurado = 4.25



    For Each plan In Worksheets
        plan.Select  

        Set i = ActiveSheet.Range("Q:Q").Find(valorProcurado)
        primeiraLinha = i.Row
        Do   
             ActiveSheet.Range("L" & i.Row & ":Q" & i.Row).Copy _
                                inicio.Range("AA" & linhaDestino)                              
            linhaDestino = linhaDestino + 1
            Set i = ActiveSheet.Range("Q:Q").FindNext(i)
        Loop While primeiraLinha < i.Row          
    Next    
    End Sub

This second way, it finds, selects, but does not glue in the start sheet.

Sub copia()

Dim plan As Object
Dim valorProcurado As Double
    valorProcurado = 4.25

Dim ant As Range
Dim contar As Integer
    contar = 1

For Each plan In Worksheets
     plan.Select
     Range("Q1").Select

    Do While contar < 300
        If UCase(ActiveCell) = UCase(valorProcurado) Then
            Range(ActiveCell.Offset(0, -4), ActiveCell.Offset(0, 1)).Copy
            Sheets("inicio").Select
            Range("AA1").Activate
            Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
            ActiveCell.PasteSpecial xlValue

        End If
        contar = contar + 1
        ActiveCell.Offset(1, 0).Select
    Loop
Next


Sheets("inicio").Select
Range("a1").Select


End Sub

After corrections and reducing the amount of cells to be copied and pasted, was like this:

Sub testecopia()


Dim procurado As Double
    procurado = 4.25
Dim i As Long
    i = 0


For Each plan In Worksheets
    With plan.Range("q1:q500")
        Set c = .Find(procurado, LookIn:=xlValues)
        If Not c Is Nothing Then
            Endereco = c.Address
            Linha = c.Row
            i = i + 1

            Do


                c.Offset(-1, -4).Select
                Selection.Copy

                Sheets("inicio").Select
                Range("AA" & 1 + i).Select
                ActiveSheet.Paste

                i = i + 1

                Set c = .FindNext(c)

            If c Is Nothing Then
                        GoTo DoneFinding
            End If
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
DoneFinding:

    End With

Next

End Sub