Search values and copy them to different workbook

[Limes]

Hi,
I am trying to find text in one spreadsheet ("PerformanceT2") in column ("E") and the copy cells from the row in which text was found from columns ("E") ("F") and ("V") from that spreadsheet ("PerformanceT2") and then copy these cells into different spreadsheet ("Cal.PerfT") and paste them in columns ("AB"), ("AC") and ("AD") respectively.

I tried to start with Cells.Find but in the end, I did not know how to stop the loop once find function cycled through all cells.

Here is macro I've been trying to run, feel free to point out mistakes

Sub Search_loop()

Dim FoundCellAdress As String
Dim i As Integer
Dim rng1, C1 As Range

FoundCellAdress = ActiveCell.Address
Set rng1 = Worksheets("Cal.PerfT").Range("AB2")
Set C1 = Worksheets("PerformanceT2").Range("E2")

    For i = 0 To 10
  
        Sheets("PerformanceT2").Select
        Cells.Find(What:="Soleri3", After:=ActiveCell, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Copy
        Sheets("Cal.PerfT").Select
        rng1.Offset(2 * i, 0).PasteSpecial
        
        Sheets("PerformanceT2").Select
        Cells.FindNext(After:=ActiveCell).Activate
        ActiveCell.Copy
        Sheets("Cal.PerfT").Select
        rng1.Offset(2 * i + 1, 0).PasteSpecial
                        
                If ActiveCell = C1 Then
                    Exit Do
                End If
  
    Next i
Loop

MsgBox "End of search"



End Sub

I appreciate any help

 

[DacEasy]

Hi, The below should give you the results you want:

Option Explicit
Sub forSearch_loop()
    Dim lastRow As Long, nextRow As Long, i As Long, h As Long, wb As Workbook
    Dim Sh1 As Worksheet, Sh2 As Worksheet, searchWord As String
    
    Set wb = ThisWorkbook
    Set Sh1 = wb.Sheets("PerformanceT2")
    Set Sh2 = wb.Sheets("Cal.PerfT")
    
    searchWord = "Soleri3"
    
    lastRow = Sh1.Cells(Rows.Count, "B").End(xlUp).Row 'Find the lastRow
    nextRow = Sh2.Cells(Rows.Count, "A").End(xlUp).Row 'Find the lastRow
    
    Sh1.Select
    h = 1
    For i = 2 To lastRow
        If Range("B" & i).Value = searchWord Then
            Sh2.Range("A" & nextRow + h) = Sh1.Range("B" & i).Value
            Sh2.Range("C" & nextRow + h) = Sh1.Range("C" & i).Value
            Sh2.Range("E" & nextRow + h) = Sh1.Range("D" & i).Value
            h = h + 1
        End If
    Next i

MsgBox "End of search"
End Sub

 

[Limes]

Hi, The below should give you the results you want:

Option Explicit
Sub forSearch_loop()
    Dim lastRow As Long, nextRow As Long, i As Long, h As Long, wb As Workbook
    Dim Sh1 As Worksheet, Sh2 As Worksheet, searchWord As String
   
    Set wb = ThisWorkbook
    Set Sh1 = wb.Sheets("PerformanceT2")
    Set Sh2 = wb.Sheets("Cal.PerfT")
   
    searchWord = "Soleri3"
   
    lastRow = Sh1.Cells(Rows.Count, "B").End(xlUp).Row 'Find the lastRow
    nextRow = Sh2.Cells(Rows.Count, "A").End(xlUp).Row 'Find the lastRow
   
    Sh1.Select
    h = 1
    For i = 2 To lastRow
        If Range("B" & i).Value = searchWord Then
            Sh2.Range("A" & nextRow + h) = Sh1.Range("B" & i).Value
            Sh2.Range("C" & nextRow + h) = Sh1.Range("C" & i).Value
            Sh2.Range("E" & nextRow + h) = Sh1.Range("D" & i).Value
            h = h + 1
        End If
    Next i

MsgBox "End of search"
End Sub

Yes it does! Thank you