gezgin-49
Altın Üye
- Katılım
- 17 Ekim 2006
- Mesajlar
- 669
- Excel Vers. ve Dili
- Türkçe 2003
- Altın Üyelik Bitiş Tarihi
- 22-09-2028
arkadaşlar bir butona birden fazla makro atanabilirmi veya düğme atamadan makronun otomatik olarak çalışması için ne yapmak lazım.
Sub cocukaktar()
On Error Resume Next
Set s1 = Sheets("veri")
Set s2 = Sheets("Çocuklar")
deg = Array("A4", "F4", "K4", "A22", "F22", "K22", "A40", "F40", "K40")
For a = 7 To s1.[f65536].End(3).Row
s2.Range(deg(a - 7)) = ""
If s1.Cells(a, "g") = "ölü" Then
s2.Range(deg(c)) = s1.Cells(a, "f")
c = c + 1
End If
Next
End Sub
Sub torunaktar()
On Error Resume Next
Set s1 = Sheets("Torunlar")
deg = Array("A4", "F4", "K4", "A22", "F22", "K22", "A40", "F40", "K40")
sut = Array(4, 9, 14, 4, 9, 14, 4, 9, 14)
sat = Array(7, 7, 7, 25, 25, 25, 43, 43, 43)
For e = 0 To 8
s1.Range(deg(e)) = ""
Next
For b = 0 To 8
For a = sat(b) To sat(b) + 8
If Cells(a, sut(b)) = "ölü" Then
s1.Range(deg(c)) = Cells(a, sut(b) - 2)
c = c + 1
End If
Next
End Sub
Sub cocukaktar()
On Error Resume Next
Set s1 = Sheets("veri")
Set s2 = Sheets("Çocuklar")
deg = Array("A4", "F4", "K4", "A22", "F22", "K22", "A40", "F40", "K40")
For a = 7 To s1.[f65536].End(3).Row
s2.Range(deg(a - 7)) = ""
If s1.Cells(a, "g") = "ölü" Then
s2.Range(deg(c)) = s1.Cells(a, "f")
c = c + 1
End If
Next
End Sub
Sub torunaktar()
On Error Resume Next
Set s1 = Sheets("Torunlar")
deg = Array("A4", "F4", "K4", "A22", "F22", "K22", "A40", "F40", "K40")
sut = Array(4, 9, 14, 4, 9, 14, 4, 9, 14)
sat = Array(7, 7, 7, 25, 25, 25, 43, 43, 43)
For e = 0 To 8
s1.Range(deg(e)) = ""
Next
For b = 0 To 8
For a = sat(b) To sat(b) + 8
If Cells(a, sut(b)) = "ölü" Then
s1.Range(deg(c)) = Cells(a, sut(b) - 2)
c = c + 1
End If
Next
End Sub