Soru Mükerrer Kayıtları Koşulları Kriter Belirterek Farklı Sayfalara Aktarma

[HsNKgL]

Selamun Aleyküm herkese hayırlı cumalar;

Ekteki örnekte sayfalara mükerrer kayıtları benzersiz olarak aktarabiliyorum. Yapmak istediğim data sayfasındaki mükerrer kayıtları kriter uygulayarak (örneğin P harfi ile başlayanlar prapor sayfasına - T harfi ile başlayanları trapor sayfasına, Sql 'deki LIKE komutuna benzer şekilde) makroda kriter belirtilerek diğer sayfalara benzersiz olarak aktarılması konusunda yardımlarınız için şimdiden teşekkür ederim...

 

[Muzaffer Ali]

Aleykümselam hayırlı cumalar.
Dosyanızdaki kodları silin aşağıdakileri kopyalayın.

Option Compare Text

Sub Benzemez()
    On Local Error Resume Next
    Set S1 = Sheets("data")
    Set S2 = Sheets("prapor")
    Set S3 = Sheets("trapor")
    x2 = 2
    x3 = 2
    For a = 2 To S1.Range("A65500").End(3).Row
        If WorksheetFunction.CountIf(S1.Range("A2:A" & a), S1.Cells(a, "A")) = 1 Then
            If Left(S1.Cells(a, "A"), 1) = "p" Then
                S2.Cells(x2, "A") = S1.Cells(a, "A")
                x2 = x2 + 1
            ElseIf Left(S1.Cells(a, "A"), 1) = "t" Then
                S3.Cells(x3, "A").Value = S1.Cells(a, "A").Value
                x3 = x3 + 1
            End If
        End If
    Next
End Sub

 

[HsNKgL]

Aleykümselam hayırlı cumalar.
Dosyanızdaki kodları silin aşağıdakileri kopyalayın.

Option Compare Text

Sub Benzemez()
    On Local Error Resume Next
    Set S1 = Sheets("data")
    Set S2 = Sheets("prapor")
    Set S3 = Sheets("trapor")
    x2 = 2
    x3 = 2
    For a = 2 To S1.Range("A65500").End(3).Row
        If WorksheetFunction.CountIf(S1.Range("A2:A" & a), S1.Cells(a, "A")) = 1 Then
            If Left(S1.Cells(a, "A"), 1) = "p" Then
                S2.Cells(x2, "A") = S1.Cells(a, "A")
                x2 = x2 + 1
            ElseIf Left(S1.Cells(a, "A"), 1) = "t" Then
                S3.Cells(x3, "A").Value = S1.Cells(a, "A").Value
                x3 = x3 + 1
            End If
        End If
    Next
End Sub

Düzeltme....
Sayın dalgalikur kod çalıştı ilginiz yardımınız için teşekkür ederim Allah razı olsun.

 

[yanginci34]

Alternatif olarak denermisiniz.

 

[HsNKgL]

Alternatif olarak denermisiniz.

Sayın yanginci34 ilginiz yardımlarınız için teşekkür ederim alternatif olarak deneyeceğim tablodan hangisi daha verimli çalışacak diye...