Şartlı listeleme

[sasys]

Merhaba üstadlar,
Ekteki dosya da olduğu gibi VERI sayfasındaki F sütunundaki bilgileri RUT sayfasındaki tablola adlarıyla eşleştirip RUT sayfasındaki tablodaki sütunlara listelemek istiyorum. BU konuda yardımcı olacak üstadlara şimdi den teşekkür ederim.

 

[korhan86119]

Merhaba dosyanız ekte.

 

[sasys]

Üstad eline koluna sağlık, benim istediğim bu kadar karmaşık değil. sadece veri sayfasının F sütununa göre RUT sayfasındaki tablo isimlerine göre yada RUT sayfasındaki hücre değerlerine göre verileri RUT sayfasına dağıtmak istemiştim.

 

[korhan86119]

Umarım işinize yaramıştır.

 

[sasys]

Umarım işinize yaramıştır.

Elbette yaradı, bu tür nezih çalışmaları bulmak kolay değil. Farklı konularda her zaman kullanacağım bir çalışma. Lakin benim istediğim daha basit, dediğim gibi VERI nin f sindeki değer ile RUT hücre değerleri ile yada tablo isimleyle eşleştirip tarihe göre ilgili tablolara listeleyecek bir şey di fakat sizin çaışmanız daha enteresan. Teşekür ederim.

 

[sasys]

Aşağıdaki şekilde bir kod yazdım, fakat sıralatmayı yapamadım. Ancak onun içinde bir makro yazıp
beraber çalışrınca sorun çözüldü.

Sub Aktar()

Dim sh As Worksheet, sat1 As Long, sat2 As Long, i As Long

Sheets("NAK").Select

Application.ScreenUpdating = False

Set sh = Sheets("RUT")

sh.Range("B3:D" & Rows.Count).ClearContents

sh.Range("F3:H" & Rows.Count).ClearContents

sh.Range("J3:L" & Rows.Count).ClearContents

sh.Range("N3:P" & Rows.Count).ClearContents

sh.Range("R3:T" & Rows.Count).ClearContents

sh.Range("V3:X" & Rows.Count).ClearContents

sh.Range("Z3:AB" & Rows.Count).ClearContents

sat1 = Cells(Rows.Count, "B").End(xlUp).Row

sat2 = 3

For i = 2 To sat1

    If UCase(Replace(Replace(Cells(i, "F").Value, "i", "İ"), "ı", "I")) = "RUT1" Then

        sh.Cells(sat2, "b").Value = Cells(i, "A").Value

        sh.Cells(sat2, "c").Value = Cells(i, "E").Value

        sh.Cells(sat2, "d").Value = Cells(i, "D").Value

        sat2 = sat2 + 1

    End If

    If UCase(Replace(Replace(Cells(i, "F").Value, "i", "İ"), "ı", "I")) = "RUT2" Then

        sh.Cells(sat2, "F").Value = Cells(i, "A").Value

        sh.Cells(sat2, "G").Value = Cells(i, "E").Value

        sh.Cells(sat2, "H").Value = Cells(i, "D").Value

        sat2 = sat2 + 1

    End If

    If UCase(Replace(Replace(Cells(i, "F").Value, "i", "İ"), "ı", "I")) = "RUT3" Then

        sh.Cells(sat2, "J").Value = Cells(i, "A").Value

        sh.Cells(sat2, "K").Value = Cells(i, "E").Value

        sh.Cells(sat2, "L").Value = Cells(i, "D").Value

        sat2 = sat2 + 1

    End If

If UCase(Replace(Replace(Cells(i, "F").Value, "i", "İ"), "ı", "I")) = "RUT4" Then

        sh.Cells(sat2, "N").Value = Cells(i, "A").Value

        sh.Cells(sat2, "O").Value = Cells(i, "E").Value

        sh.Cells(sat2, "P").Value = Cells(i, "D").Value

        sat2 = sat2 + 1

    End If

     If UCase(Replace(Replace(Cells(i, "F").Value, "i", "İ"), "ı", "I")) = "RUT5" Then

        sh.Cells(sat2, "R").Value = Cells(i, "A").Value

        sh.Cells(sat2, "S").Value = Cells(i, "E").Value

        sh.Cells(sat2, "T").Value = Cells(i, "D").Value

        sat2 = sat2 + 1

    End If

     If UCase(Replace(Replace(Cells(i, "F").Value, "i", "İ"), "ı", "I")) = "RUT6" Then

        sh.Cells(sat2, "V").Value = Cells(i, "A").Value

        sh.Cells(sat2, "W").Value = Cells(i, "E").Value

        sh.Cells(sat2, "X").Value = Cells(i, "D").Value

        sat2 = sat2 + 1

    End If

       If UCase(Replace(Replace(Cells(i, "F").Value, "i", "İ"), "ı", "I")) = "RUT7" Then

        sh.Cells(sat2, "Z").Value = Cells(i, "A").Value

        sh.Cells(sat2, "AA").Value = Cells(i, "E").Value

        sh.Cells(sat2, "AB").Value = Cells(i, "D").Value

        sat2 = sat2 + 1

    End If

Next i

sh.Select

Application.ScreenUpdating = False

Set sh = Nothing

MsgBox "veriler aktarıldı.", _

    vbOKOnly + vbInformation, Application.UserName


End

End

End

End

End

End

End Sub