Soru P sutununda EĞİTİM veya eğitim yazısı varsa komple ayrı sayfaya listelesin hk.

[balanar]

Merhaba, örnek bi dosya ekledim normalde 800 adet veri var bu şekilde..

Eğer "P" sutunuda EĞİTİM, eğitim kelimesi geçiyorsa


İlgili hücrelerin A'dan T'ye kadar olan verilerini alt alta Sayfa2'ye sıralasın istiyorum yardımcı olur musunuz?

 

[Muzaffer Ali]

Merhaba.
Bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim syf1 As Worksheet, syf2 As Worksheet
    Dim Bak As Long, Say As Long
    Dim Bul As Range
    Set syf1 = ThisWorkbook.Worksheets("Sayfa1")
    Set syf2 = ThisWorkbook.Worksheets("Sayfa2")
    Set Bul = syf1.Range("P1")
    syf1.Range("A1:T1").Copy
    syf2.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
    
    For Bak = 1 To syf1.Cells(Rows.Count, "P").End(xlUp).Row
        Set Bul = syf1.Range("P" & Bak & ":P" & Bak).Find(what:="Eğitim", lookat:=xlPart)
        If Not Bul Is Nothing Then
            If syf2.Cells(1, "P") = "" Then Say = 1 Else Say = syf2.Cells(Rows.Count, "P").End(xlUp).Row + 1
            syf1.Range("A" & Bak & ":T" & Bak).Copy syf2.Range("A" & Say)
        End If
    Next
    MsgBox "İşlem tamamlandı."
End Sub