sayfa değişim makrosunda kod çok uzun hata veriyor

[ismailozkan4224]

değerli arkadaşlar aşağıdaki kodla ilk on sayfadan veri alabiliyorum. ancak 18. sayfadan sonra hata veriyor. sanırım kod çok uzun geliyor. tabiki bunun yanında ben 18. sayfaya kadar kod yazdım. daha 32 sayfam var ama makro hata veriyor.örnek dosyaEKTEDİR. tümü sayfasında tümü seçildiğinde 50 sayfadaki tüm öğrenciler gelmeli.. toplamda 50 sayfadan veri alacak.
sayfaisimlerim 1-A,1-B.......1-J------------2-A,2-B........2-J---------3-A,3-B.......3-J------------4-A,4-B........4-J--------ANASINIFI-A,ANASINIFI-B.......ANASINIFI-J şeklinde ve VERİLER SAYFASINDA C20-C70 arasında var. 10'ar sayfadan toplam 50 sayfadır
bunun bir döngü ile kısa yoldan yapılma ihtimali var mı?
yoksa makro hatasını nasıl çözümleyebiliriz?
teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range(Cells(3, 1), Cells(1500, 30)).Select
Selection.ClearContents
Aranacak = [A1].Value
'--------------------------------------------------------------------------------------------------------------------
'1nolusayfadaaranıyor
Sayı1 = WorksheetFunction.CountIf(Sheets("1-A").Columns("II:II"), Aranacak)
sonsatır1 = Sheets("1-A").Cells(50, "II").End(xlUp).Row
For satır1 = 1 To sonsatır1
If Sheets("1-A").Cells(satır1, 243).Value = Aranacak Then
If değer1 > Sayı1 + 2 Then Exit Sub
If değer1 >= 3 Then GoTo ileri11
değer1 = 3
GoTo ileri12
ileri11:
değer1 = değer1 + 1
ileri12:
Cells(değer1, 2).Value = Sheets("1-A").Cells(satır1, 2).Value
Cells(değer1, 3).Value = Sheets("1-A").Cells(satır1, 3).Value
Cells(değer1, 4).Value = Sheets("1-A").Cells(satır1, 4).Value
Cells(değer1, 5).Value = Sheets("1-A").Cells(satır1, 5).Value
Cells(değer1, 6).Value = Sheets("1-A").Cells(satır1, 6).Value
Cells(değer1, 7).Value = Sheets("1-A").Cells(satır1, 7).Value
Cells(değer1, 8).Value = Sheets("1-A").Cells(satır1, 8).Value
Cells(değer1, 9).Value = Sheets("1-A").Cells(satır1, 9).Value
Cells(değer1, 10).Value = Sheets("1-A").Cells(satır1, 10).Value
Cells(değer1, 11).Value = Sheets("1-A").Cells(satır1, 11).Value
Cells(değer1, 12).Value = Sheets("1-A").Cells(satır1, 12).Value
Cells(değer1, 13).Value = Sheets("1-A").Cells(satır1, 13).Value
Cells(değer1, 14).Value = Sheets("1-A").Cells(satır1, 14).Value
Cells(değer1, 15).Value = Sheets("1-A").Cells(satır1, 15).Value
Cells(değer1, 16).Value = Sheets("1-A").Cells(satır1, 16).Value
Cells(değer1, 17).Value = Sheets("1-A").Cells(satır1, 17).Value
Cells(değer1, 18).Value = Sheets("1-A").Cells(satır1, 18).Value
Cells(değer1, 19).Value = Sheets("1-A").Cells(satır1, 19).Value
Cells(değer1, 20).Value = Sheets("1-A").Cells(satır1, 20).Value
Cells(değer1, 21).Value = Sheets("1-A").Cells(satır1, 21).Value
Cells(değer1, 22).Value = Sheets("1-A").Cells(satır1, 22).Value
Cells(değer1, 23).Value = Sheets("1-A").Cells(satır1, 23).Value
Cells(değer1, 24).Value = Sheets("1-A").Cells(satır1, 24).Value
Cells(değer1, 25).Value = Sheets("1-A").Cells(satır1, 25).Value
Cells(değer1, 26).Value = Sheets("1-A").Cells(satır1, 26).Value
Cells(değer1, 27).Value = Sheets("1-A").Cells(satır1, 27).Value
End If
Next satır1

'2nolusayfadaaranıyor
Sayı2 = WorksheetFunction.CountIf(Sheets("1-B").Columns("II:II"), Aranacak)
sonsatır2 = Sheets("1-B").Cells(65536, "II").End(xlUp).Row
For satır2 = 1 To sonsatır2
If Sheets("1-B").Cells(satır2, 243).Value = Aranacak Then
If değer2 > Sayı1 + Sayı2 + 2 Then Exit Sub
If değer2 >= 3 + Sayı1 Then GoTo ileri21
değer2 = 3 + Sayı1
GoTo ileri22
ileri21:
değer2 = değer2 + 1
ileri22:
Cells(değer2, 2).Value = Sheets("1-B").Cells(satır2, 2).Value
Cells(değer2, 3).Value = Sheets("1-B").Cells(satır2, 3).Value
Cells(değer2, 4).Value = Sheets("1-B").Cells(satır2, 4).Value
Cells(değer2, 5).Value = Sheets("1-B").Cells(satır2, 5).Value
Cells(değer2, 6).Value = Sheets("1-B").Cells(satır2, 6).Value
Cells(değer2, 7).Value = Sheets("1-B").Cells(satır2, 7).Value
Cells(değer2, 8).Value = Sheets("1-B").Cells(satır2, 8).Value
Cells(değer2, 9).Value = Sheets("1-B").Cells(satır2, 9).Value
Cells(değer2, 10).Value = Sheets("1-B").Cells(satır2, 10).Value
Cells(değer2, 11).Value = Sheets("1-B").Cells(satır2, 11).Value
Cells(değer2, 12).Value = Sheets("1-B").Cells(satır2, 12).Value
Cells(değer2, 13).Value = Sheets("1-B").Cells(satır2, 13).Value
Cells(değer2, 14).Value = Sheets("1-B").Cells(satır2, 14).Value
Cells(değer2, 15).Value = Sheets("1-B").Cells(satır2, 15).Value
Cells(değer2, 16).Value = Sheets("1-B").Cells(satır2, 16).Value
Cells(değer2, 17).Value = Sheets("1-B").Cells(satır2, 17).Value
Cells(değer2, 18).Value = Sheets("1-B").Cells(satır2, 18).Value
Cells(değer2, 19).Value = Sheets("1-B").Cells(satır2, 19).Value
Cells(değer2, 20).Value = Sheets("1-B").Cells(satır2, 20).Value
Cells(değer2, 21).Value = Sheets("1-B").Cells(satır2, 21).Value
Cells(değer2, 22).Value = Sheets("1-B").Cells(satır2, 22).Value
Cells(değer2, 23).Value = Sheets("1-B").Cells(satır2, 23).Value
Cells(değer2, 24).Value = Sheets("1-B").Cells(satır2, 24).Value
Cells(değer2, 25).Value = Sheets("1-B").Cells(satır2, 25).Value
Cells(değer2, 26).Value = Sheets("1-B").Cells(satır2, 26).Value
Cells(değer2, 27).Value = Sheets("1-B").Cells(satır2, 27).Value
End If
Next satır2

'3nolusayfadaaranıyor
'4Nolusayfadaaranıyor...........VE BU SAYFA SAYISI 50 YE KADAR ÇIKIYOR

Application.EnableEvents = True
Target.Select

End Sub

 

[msoauy]

Aşağıdaki kodları dener misin

Verilen örneğe göre bu şekilde bir kısaltma yapılabilir.
Ayrıca procedure too long hatası veriyor kod "for each" ve "for" loop ları kullanmak basitlik sağlayacaktır kodlarda.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim Aranacak As String
Dim Sayi As Double, _
    Satir As Double, _
    sonSatir As Double, _
    ind As Double

'A1 verisi kontrol ediliyor...
If Intersect(Target, [A1]) Is Nothing Then Exit Sub

Application.EnableEvents = False
Range(Cells(3, 1), Cells(1500, 30)).ClearContents
Aranacak = [A1].Value
TempSatir = 0
For Each ws In Worksheets
    If Not (ws.Name = ActiveSheet.Name Or ws.Name = "VERİLER" Or ws.Name = "KULÜP LİSTESİ") Then
    
        Sayi = WorksheetFunction.CountIf(ws.Columns("II:II"), Aranacak) 'II satırında "Aranacak" kelimesi kaç tane var
        sonSatir = ws.Cells(Rows.Count, "II").End(xlUp).Row 'Son satırı bul
        TempSayi = TempSayi + Sayi
        For Satir = 1 To sonSatir
            If ws.Cells(Satir, "II").Value = Aranacak Then
            
                If deger > TempSayi + 2 Then Exit Sub 'Deger sayının 2 fazlasından büyükse döngüden çık
                If deger >= 3 Then
                    deger = deger + 1
                Else
                    deger = 3
                End If
                
                For ind = 2 To 27
                    ActiveSheet.Cells(deger, ind).Value = ws.Cells(Satir, ind).Value
                Next ind
                
            End If
        Next Satir
    End If
Next ws

Call sayilarikopyala
Call sutunbasliklari
Application.EnableEvents = True
Target.Select
End Sub