Hem sayfa adına hem bir hücreye göre aktarma yapmak

[aydgur]

Sub Aktaryeni2008erol()
SonSatir = Sheets("İMALAT").[A65536].End(3).Row + 1
Sheets("ANASAYFA").Range("A2:BL80").Copy Sheets("İMALAT").Range("A" & SonSatir)
Call sonerolaktarmaimalatlı5
End Sub
Sub sonerolaktarmaimalatlı5()
Sheets("ANASAYFA").Select
For X = 2 To [A65536].End(3).Row
Set s2 = Sheets(Cells(X, 1).Text)
sira = s2.[A65536].End(3).Row + 1

Select Case s2.Name
Case Else:
For y = 1 To 9
s2.Cells(sira, y) = Cells(X, y + 1)
Next y
End Select
Next X
Sheets("ANASAYFA").Select
Range("A2:H80").ClearContents
Range("J2:BO80").ClearContents
Sheets("ANASAYFA").Select
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
MsgBox ("AKTARIM TAMAMLANDI")
End Sub
Bu kodlar sayesinde önce tüm ANASAYFA yı İMALAT sayfasına kopyalıyor,sonrada a sütunundaki sayfa adlarına göre ANASAYFA nın B den J ye kadar bilgilerini aktarabiliyorum.Yapmak istediğim ; A sütunundaki sayfa adlarına göre aktarırken ;eğer F sütununda ÇEK yazıyorsa ANASAYFA nın A,B,K,L,M,N,O,P,Q sütunlarınıda ÇEK sayfasına B sütunundan itibaren kopyalamak.Şimdidden teşekkür ederim...