Bir modül içinde iki ayrı makroyu çalıştırmak

[zırzır]

Arkadaşlar,bir modül içinde iki ayrı makroyu çalıştırıp iki ayrı sayfada işlem yapabilirmiyim.

 

[kombo]

Yapabilirsiniz.

 

[zırzır]

Sayın kombo,aşağıdaki makroya bir buton atanmış,modüle aynı makrodan bir daha
nasıl yazabiliriz.Yani bir buton ile iki makroyu nasıl çalıştırabiliriz.

Sub puant()
Set s1 = Sheets("154")
Set s2 = Sheets("154 fider puant")
For bak1 = 6 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26)) = s1.Range("AB44:BA44").Value
End If
Next
End Sub

 

[kombo]

Sub puant()
Set s1 = [COLOR=black]Sheets("154")[/COLOR]
Set s2 = [COLOR=black]Sheets("154 fider puant")[/COLOR]
For bak1 = 6 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26)) = s1.Range("AB44:BA44").Value
End If
Next
[COLOR=red]call puant1[/COLOR]
End Sub
 
Sub [COLOR=red]puant1()[/COLOR]
Set s1 = [COLOR=blue]Sheets("154")[/COLOR]
Set s2 = [COLOR=blue]Sheets("154 fider puant")[/COLOR]
For bak1 = 6 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26)) = s1.Range("AB44:BA44").Value
End If
Next
End Sub

AÇIKLAMA: puant1 makrosunda Sayfa İsimlerini Hangi sayfaya kayıt alacaksanız ona göre düzenleyin.

 

[zırzır]

Sayın kombo,butonu hangi makroya atayacağım makro bu haliyle düzgün çalışmıyor


Sub puant()
Set s1 = Sheets("AS")
Set s2 = Sheets("FİDER")
For bak1 = 1 To 20
If s2.Range("A" & bak1) = s1.Range("B1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 6)) = s1.Range("A4:F4").Value
End If
Next
Call puant1
End Sub

Sub puant1()
Set s1 = Sheets("MAS")
Set s2 = Sheets("380")
For bak1 = 1 To 20
If s2.Range("A" & bak1) = s1.Range("B1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 12)) = s1.Range("A5:L5").Value
End If
Next
End Sub

 

[Seyit Tiken]

Aşağıdaki kodların mantığına bakıp anlayarak, kendinize uyarlayın.

Sub a()
[a1] = "zır"
End Sub

Sub b()
[b1] = "zırzır"
End Sub

Sub Düğme1_Tıklat()
a
b
End Sub

 

[zırzır]

Sayın Seyit Tiken,verdiğiniz mantıkla yaptığım zaman makrolar çalışmıyor
"Sub b()" yazısı sarı renkli oluyor. Butonu "Sub dügme1_tıklat()" makrosuna atadım olmadı hatayı düzeltebilirmisin.



Sub a()
[a1] = "154"
Set s1 = Sheets("154")
Set s2 = Sheets("154 fider puant")
For bak1 = 6 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26)) = s1.Range("AB44:BA44").Value
End If
Next
End Sub

Sub b()
[b1] = "380"
Set s1 = Sheets("380")
Set s2 = Sheets("380 fider puant")
s2.[B1:G50]
For bak1 = 1 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 17)) = s1.Range("B40:R40").Value
End If
Next

Sub dügme1_tıklat()
a
b
End Sub

 

[AS3434]

Sub puant()
Set s1 = Sheets("AS")
Set s2 = Sheets("FİDER")
For bak1 = 1 To 20
If s2.Range("A" & bak1) = s1.Range("B1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 6)) = s1.Range("A4:F4").Value
End If
Next
Call puant1
End Sub

Sub puant1()
Set s1 = Sheets("MAS")
Set s2 = Sheets("380")
For bak1 = 1 To 20
If s2.Range("A" & bak1) = s1.Range("B1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 12)) = s1.Range("A5:L5").Value
End If
Next
End Sub

Normal şartlarda bu şekilde çalışması lazım. Butona puant makrosunu atayın.

makro bu haliyle düzgün çalışmıyor

Nerede hata veriyor?

 

[Seyit Tiken]

Kodlarınızı müstakil olarak çalıştırın. Kodlarınızda bir çelişki olabilir.

 

[zırzır]

Sayın AS3434, puant1 makrosunun 380 adlı sayfadaki "B40:R40"teki sayı dizisi
"380 fider puant"sayfasına taşınıyor ama benim seçtiğim tarihte değilde 1 den
36 ıncı satırlara kadar aynı diziyi kopyalıyor.Butonu "puant"makrosuna atadım.
1inci makro düzgün çalışıyor,sorun herhalde 2inci makro ve tarih seçmede.

Sub puant()
Set s1 = Sheets("154")
Set s2 = Sheets("154 fider puant")
For bak1 = 6 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26)) = s1.Range("AB44:BA44").Value
End If
Next
Call puant1
End Sub

Sub puant1()
Set s1 = Sheets("380")
Set s2 = Sheets("380 fider puant")
For bak1 = 1 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 17)) = s1.Range("B40:R40").Value
End If
Next
End Sub

 

[AS3434]

Sn. Seyit Tiken'in önerdiği gibi yapın. puant1 makrosunu başka bir buton vasıtasıyla çalıştırın. Eğer yine hata veriyorsa makroda hata var demektir. Hatayı bulup, Düzeltme yoluna gidin.

 

[zırzır]

Sayın AS3434,makroları tek buton ile çalıştırdım.Ancak buton ve tarihi hangi makroya atarsam o makronun tarihi çalışıyor. Aşağıdaki modülde "puant1" makrosunun tarihini yukarıdaki "puant" makrosunun tarihine nasıl adapte ederiz.

Düzenlenecek satır "If s2.Range("A" & bak1) = s1.Range("AB1") Then"


Sub puant()
Set s1 = Sheets("AS")
Set s2 = Sheets("FİDER")
For bak1 = 5 To 28
If s2.Range("A" & bak1) = s1.Range("A1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 17)) = s1.Range("B40:R40").Value
End If
Next
End Sub
--------------------------------
Sub puant1()
Set s1 = Sheets("154")
Set s2 = Sheets("154 fider puant")
For bak1 = 6 To 36
If s2.Range("A" & bak1) = s1.Range("AB1") Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26)) = s1.Range("AB44:BA44").Value
End If
Next
End Sub
------------------------
Sub Düğmetıkla()
puant
puant1
End Sub

 

[AS3434]

Sub puant1()
Set s1 = Sheets("154")
Set s2 = Sheets("154 fider puant")
[COLOR="Red"]Set s3 = Sheets("AS")[/COLOR]
For bak1 = 6 To 36
If s2.Range("A" & bak1) = [COLOR="red"]s3.Range("AB1") [/COLOR]Then
s2.Select
s2.Range("A" & bak1).Select
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26)) = s1.Range("AB44:BA44").Value
End If
Next
End Sub

Tarih hücresi hangi sayfa ve hangi hücre onu bilmeden yanıt vermek zor. Anlayabildiğim kadarıyla AS sayfasında AB1 hücresinde gibi geldi.

 

[zırzır]

Sayın AS3434,teşekkür ederim şimdi oldu.Elinize sağlık.Size şunu da sormak isterim,tarihi makinanın sistem tarihinden alamazmıyız "gün ve ay" olarak yani makina her gün tarihini değiştirdiğinde,excel sayfamdaki tarih hücreside otomatik olarak değişsin.Böyle bir makro varmı.Saygılar.

 

[AS3434]

Makroya gerek yok. Tarih olan hücrenize

=bugün()

Yazın.