VBA Macro Copy and Paste

[Veni11]

Hii

My code below detects whether a certain number is in row K, if it finds it then it goes to another sheet, copies the defined rows and inserts them into the last row of the current sheet.
My problem now is that the number that is being searched for in row K can also appear several times in the row, which means that the code now inserts the rows several times. I can't figure out how to rewrite it so that the counter stops as soon as it has found the number once in the row and thus the rows from the other sheet are only copied in once and not multiple times.

For the example in the code below. If "33527" is 5times in the row K than the rows 22:25 from the other sheet are copied and pasted 5 times into the current sheet but my goal is that it is only copied and pasted once regardless how many times the item is listed in row K.

I hope you get what I mean. Thank you for your help

Private Sub Wall()

Dim i As Long, lastrow1 As Long
Dim myname As String

lastrow1 = Sheets("Material").Range("K" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow1
myname = "33527"

Application.ScreenUpdating = False


    If Worksheets("Material").Cells(i, "K").Value = myname Then
    Worksheets("stock").Activate
    Worksheets("stock").Rows("22:25").Copy
    Worksheets("Material").Activate
    Sheets("Material").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If

Application.CutCopyMode = False
Next i

Application.ScreenUpdating = True


End Sub

 

[kevin9999]

Please try the following on a copy of your workbook.

Option Explicit
Sub Veni11()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Material")
    Set ws2 = Worksheets("stock")
    Dim s As String, a, i As Long
    s = "33527"
    a = WorksheetFunction.Unique(ws1.Range("K2", ws1.Cells(Rows.Count, "K").End(xlUp)))
    For i = LBound(a, 1) To UBound(a, 1)
        If InStr(a(i, 1), s) > 0 Then ws2.Rows("22:25").Copy ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next i
End Sub

 

[Veni11]

Please try the following on a copy of your workbook.

Option Explicit
Sub Veni11()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Material")
    Set ws2 = Worksheets("stock")
    Dim s As String, a, i As Long
    s = "33527"
    a = WorksheetFunction.Unique(ws1.Range("K2", ws1.Cells(Rows.Count, "K").End(xlUp)))
    For i = LBound(a, 1) To UBound(a, 1)
        If InStr(a(i, 1), s) > 0 Then ws2.Rows("22:25").Copy ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next i
End Sub

You Sir are a genius. Thank you so much! It worked perfect!

 

[kevin9999]

Happy to help, and thanks for the feedback