Koda yardım Lütfen

[honestguy25]

Selamlar (Bibliografya) isimli bir veri sayfam var. C stünu yazar isimi, E stunu konu ismi
C ve E stunlarına göre sayfalar var. E stunu ile yeni sayfayı aşağıdaki kod ile oluşturuyorum. Aynı konularldarki kitapların yazar sayfalarına gidiyor ve oradan veriyi, yeni oluşturduğu konu sayfasına aktarıyor. Fakat yazar sayfasındaki bütün verileri aktarıyor. bunu yapmasın yalnızca konu sayfasının ismini baz alarak yalnızca bu konudaki satırları aktarsın.

Umarım anlatabilmişimdir. Bunu nasıl yaparım bilemedim

Option Explicit
Sub Deneme1()
Dim i, j, xr, sira As Long, sat1 As Long, Tok As String, Tik As String, s1 As Worksheet, T1 As Worksheet
Set s1 = Sheets("Bibliography")
Application.ScreenUpdating = False
For i = 3 To s1.[E65536].End(3).Row
Tok = s1.Cells(i, "E")
Tik = s1.Cells(i, "C") 'c sütünunda yazar isimleri sayfalları'
Set T1 = Sheets(Tik) 'Yazar sayfaları'
sat1 = T1.Cells(Rows.Count, "B").End(3).Row 'yazar sayfalarının en son yazılı yere kadar'
If Not Sayfakontrol(Tok) Then

Sheets("LİSTE").Select
Sheets("LİSTE").Copy after:=Worksheets(Worksheets.Count)
Sheets("LİSTE (2)").Select
Sheets("LİSTE (2)").Name = Tok
End If

sira = Sheets(Tok).Cells(Rows.Count, "B").End(3).Row + 1

If Application.WorksheetFunction.CountIf(Sheets(Tok).Range("f2:f65000"), s1.Range("f" & i)) > 0 Then
GoTo atla

Else

T1.Range("A2:N" & sat1).Copy Sheets(Tok).Cells(sira, "A")

Sheets(Tok).Range("A:n").EntireColumn.AutoFit
End If
atla:
Next i
Set s1 = Nothing
Application.ScreenUpdating = True
End Sub

 

[Saban Sertkaya]

Örnek dosyanızı (veya küçük bir örneğini) eklemeniz daha doğru ve daha hızlı cevap almanızı kolaylaştıracaktır.

 

[Korhan Ayhan]

Konu başlığınız yetersiz...

"Koda yardım lütfen" yerine "Veri sayfasından yazar ve konu başlıklarına göre aktarım yapmak" olabilir.