Makro Çalışmıyor

[akmes]

Merhaba arkadaşlar, Data sayfasındaki veri satırı 84000 e ulaşınca aşağıda makrolar çalışmıyor excel donuyor.

Sub makro1()
Dim sh As Worksheet, sonsat As Long
Sheets("Analiz").Select
Range("A4:ap" & Rows.Count).ClearContents
Set sh = Sheets("Data")
sh.Range("A3:ap" & Rows.Count).AutoFilter
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
sh.Range("A3:ap" & sonsat).AutoFilter field:=1, Criteria1:=Range("B1").Value
sh.Range("A3:ap" & sonsat).CurrentRegion.Offset(2, 0).Copy
Range("A4").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
sh.AutoFilterMode = False
End Sub

Sub makro2()
Dim sh As Worksheet, sonsat As Long
Sheets("Analiz").Select
Range("A26:ap" & Rows.Count).ClearContents
Set sh = Sheets("Data")
sh.Range("I3:ap" & Rows.Count).AutoFilter
sonsat = sh.Cells(Rows.Count, "I").End(xlUp).Row
sh.Range("I3:ap" & sonsat).AutoFilter field:=1, Criteria1:=Range("I1").Value
sh.Range("A3:ap" & sonsat).CurrentRegion.Offset(2, 0).Copy
Range("A28").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
sh.AutoFilterMode = False
End Sub

Sub makro3()
Dim sh As Worksheet, sonsat As Long
Sheets("Analiz").Select
Range("A31:AP" & Rows.Count).ClearContents
Set sh = Sheets("Data")
sh.Range("j3:CS" & Rows.Count).AutoFilter
sonsat = sh.Cells(Rows.Count, "j").End(xlUp).Row
sh.Range("j3:AP" & sonsat).AutoFilter field:=1, Criteria1:=Range("I1").Value
sh.Range("A3:AP" & sonsat).CurrentRegion.Offset(2, 0).Copy
Range("A33").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
sh.AutoFilterMode = False
End Sub

Sub makro4()
Dim sh As Worksheet, sonsat As Long
Sheets("Analiz").Select
Range("A36:ap" & Rows.Count).ClearContents
Set sh = Sheets("Data")
sh.Range("j3:ap" & Rows.Count).AutoFilter
sonsat = sh.Cells(Rows.Count, "j").End(xlUp).Row
sh.Range("j3:ap" & sonsat).AutoFilter field:=1, Criteria1:=Range("j1").Value
sh.Range("A3:ap" & sonsat).CurrentRegion.Offset(2, 0).Copy
Range("A38").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
sh.AutoFilterMode = False
End Sub

Sub makro5()
Dim sh As Worksheet, sonsat As Long
Sheets("Analiz").Select
Range("A41:ap" & Rows.Count).ClearContents
Set sh = Sheets("Data")
sh.Range("I3:ap" & Rows.Count).AutoFilter
sonsat = sh.Cells(Rows.Count, "I").End(xlUp).Row
sh.Range("I3:ap" & sonsat).AutoFilter field:=1, Criteria1:=Range("j1").Value
sh.Range("A3:ap" & sonsat).CurrentRegion.Offset(2, 0).Copy
Range("A43").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
sh.AutoFilterMode = False
End Sub

Sub makro6()
Dim sh As Worksheet, sonsat As Long
Sheets("Analiz").Select
Range("A46:ap" & Rows.Count).ClearContents
Set sh = Sheets("Data")
sh.Range("B3:ap" & Rows.Count).AutoFilter
sonsat = sh.Cells(Rows.Count, "B").End(xlUp).Row
sh.Range("B3:ap" & sonsat).AutoFilter field:=1, Criteria1:=Range("C1").Value
sh.Range("B3:ap" & sonsat).CurrentRegion.Offset(2, 0).Copy
Range("A48").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
sh.AutoFilterMode = False
Sheets("Analiz").Select
Range("b3").Select
End Sub

Sub hepsini_calistir()
Call makro1
Call makro2
Call makro3
Call makro4
Call makro5
Call makro6
End Sub

Yardım ve önerileriniz için şimdiden teşekkür ederim.

 

[turist]

Son makroyu aşağıdaki gibi deneyin.
Sub hepsini_calistir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Call makro1
Call makro2
Call makro3
Call makro4
Call makro5
Call makro6
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[akmes]

Son makroyu aşağıdaki gibi deneyin.
Sub hepsini_calistir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Call makro1
Call makro2
Call makro3
Call makro4
Call makro5
Call makro6
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

İlginiz ve yardımınız için teşekkür ederim.

Şöyle bir hata aldım.
Run Time error '1004'
Range sınıfının AutuFilter yöntemi başarısız.

Aşaıdaki makrodaki satır hatası verdi

Sub makro1()
Dim sh As Worksheet, sonsat As Long
Sheets("Analiz").Select
Range("A4:ap" & Rows.Count).ClearContents
Set sh = Sheets("Data")
sh.Range("A3:ap" & Rows.Count).AutoFilter
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
sh.Range("A3:ap" & sonsat).AutoFilter field:=1, Criteria1:=Range("B1").Value
sh.Range("A3:ap" & sonsat).CurrentRegion.Offset(2, 0).Copy
Range("A4").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
sh.AutoFilterMode = False
End Sub

 

[turist]

Application.DisplayAlerts = False
ve
Application.DisplayAlerts = true

satırlarını silip deneyin

 

[akmes]

Application.DisplayAlerts = False
ve
Application.DisplayAlerts = true

satırlarını silip deneyin

Sub hepsini_calistir()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Call makro1
Call makro2
Call makro3
Call makro4
Call makro5
Call makro6
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Yukarıdaki gibi değiştirdim. Bu sefer excel yanıt vermiyor hatası aldım.

 

[turist]

Anlaşılan dosyanızın boyutu büyük, ve benzer işlemleri 6 defa tekrarla kullanıyorsunuz.
Bellek dolması nedeniyle cevap vermiyor olabilir.
Excel'i ve bilgisayarınızı tamamen kapatın. Tekrar açıp deneyin.