Kod içersinde başka bir makronun çalıştırılması

[tahsinanarat]

Private Sub CommandButton1_Click()
Dim i As Long, sat As Long
Sheets("Liste").Select
Application.ScreenUpdating = False
Sheets("Aktarılan").Range("A2:Z65536").ClearContents
sat = 2
For i = 1 To Cells(65536, TextBox2.Value).End(xlUp).Row
If LCase(Replace(Replace(Cells(i, TextBox2.Value).Value, "I", "ı"), "ı", "ı")) Like _
"*" & TextBox1.Value & "*" Then
adr1 = Range(Cells(i, "A"), Cells(i, "Z")).Address
adr2 = Range(Cells(sat, "A"), Cells(sat, "Z")).Address
Sheets("Aktarılan").Range(adr2).Value = Range(adr1).Value
sat = sat + 1
Adet = sat + 1 - 3
End If
Next
Application.ScreenUpdating = True
End Sub

Bu makrom sağlıklı şekilde çalışıyor.

Benim istediğim; aktarılan sayfasının a2 hücresi dolu ise kopyala adlı makrom çalışsın, eğer boş ise işlemi bitirsin ve çıkış yapsın istiyorum.
Yukarıdaki kodları nasıl bir ilave yapabilirim, teşekkürler

 

[leumruk]

Private Sub CommandButton1_Click()
Dim i As Long, sat As Long
Sheets("Liste").Select
Application.ScreenUpdating = False
Sheets("Aktarılan").Range("A2:Z65536").ClearConten ts
sat = 2
For i = 1 To Cells(65536, TextBox2.Value).End(xlUp).Row
If LCase(Replace(Replace(Cells(i, TextBox2.Value).Value, "I", "ı"), "ı", "ı")) Like _
"*" & TextBox1.Value & "*" Then
adr1 = Range(Cells(i, "A"), Cells(i, "Z")).Address
adr2 = Range(Cells(sat, "A"), Cells(sat, "Z")).Address
Sheets("Aktarılan").Range(adr2).Value = Range(adr1).Value
sat = sat + 1
Adet = sat + 1 - 3
End If
Next

[COLOR="Red"]If Sheets("Aktarılan").Range("A2") <> "" Then Call kopyala[/COLOR]

Application.ScreenUpdating = True
End Sub

Bu şekilde dener misiniz?

 

[Skorpiyon]

Sayın tahsinanarat,

Şu an makinede excel yüklü olmadığından sadece tahmini yazıyorum. Aşağıdaki şekilde yazarak dener misiniz.


Private Sub CommandButton1_Click()
Dim i As Long, sat As Long
Sheets("Liste").Select
Application.ScreenUpdating = False
Sheets("Aktarılan").Range("A2:Z65536").ClearConten ts
sat = 2

if aktarilansayfaniz.Range("A2").Value <> "" then

For i = 1 To Cells(65536, TextBox2.Value).End(xlUp).Row
If LCase(Replace(Replace(Cells(i, TextBox2.Value).Value, "I", "ı"), "ı", "ı")) Like _
"*" & TextBox1.Value & "*" Then
adr1 = Range(Cells(i, "A"), Cells(i, "Z")).Address
adr2 = Range(Cells(sat, "A"), Cells(sat, "Z")).Address
Sheets("Aktarılan").Range(adr2).Value = Range(adr1).Value
sat = sat + 1
Adet = sat + 1 - 3
End If
Next

else
exit sub
end if

Application.ScreenUpdating = True
End Sub

 

[tahsinanarat]

Sn. Leumrux'un kodlarını çalıştı, Sn. Şaban Sertkaya sizin kodları bir türlü çalıştıramadım. Denemeye devam ediyorum, her ikinize de çok teşekkür ediyorum. Saygılar.