Makroda değeri değiştirmek

[ant1905]

Arkadaşlar ufak bir yardıma ihtiyacım var. Bir sayfada butona atamak üzere aşağıda bir kısmını yazdığım makroyu kaydettim. Fakat bu makro sadece "ocak" isimli sayfada çalışıyor. Aynı makroyu diğer sayfalarda oluşturduğum butonlara da atayabilmek istiyorum çünkü makronun sıralama yaptığı adresler birbirinin aynı.
ActiveWorkbook.Worksheets("OCAK") yazan kısımları
ActiveWorkbook.
şeklinde yani Worksheets("OCAK") kısımlarını silersem sorun çözülür mü yoksa başka birşey mi yapmam gerekiyor ?



Range("AJ5:AS24").Select
ActiveWorkbook.Worksheets("OCAK").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("OCAK").Sort.SortFields.Add Key:=Range("AS5:AS24" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("OCAK").Sort.SortFields.Add Key:=Range("AQ5:AQ24" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("OCAK").Sort.SortFields.Add Key:=Range("AJ5:AJ24" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("OCAK").Sort
.SetRange Range("AJ5:AS24")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("BA5:BJ24").Select
ActiveWorkbook.Worksheets("OCAK").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("OCAK").Sort.SortFields.Add Key:=Range("BJ5:BJ24" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 

[baydeniro]

Merhaba ant1905, lütfen dosya ekleyin.

 

[Mehmet Şahin]

Merhaba,
aşağıdaki kodları bir modüle kopyalayınız ve oluşturduğunuz butona "test" adlı makro'yu atayınız. İyi akşamlar.

Sub test()
Call sirala(ActiveSheet.Name)
End Sub
Sub sirala(shname As String)
Range("AJ5:AS24").Select
ActiveWorkbook.Worksheets(shname).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(shname).Sort.SortFields.Add Key:=Range("AS5:AS24" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(shname).Sort.SortFields.Add Key:=Range("AQ5:AQ24" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(shname).Sort.SortFields.Add Key:=Range("AJ5:AJ24" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(shname).Sort
.SetRange Range("AJ5:AS24")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("BA5:BJ24").Select
ActiveWorkbook.Worksheets(shname).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(shname).Sort.SortFields.Add Key:=Range("BJ5:BJ24" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
End Sub

 

[Mehmet Şahin]

Yukarıdaki kod'da değişiklik yaptım, kopyalarken hatalı kopyalama yapmıştım. Kolay gelsin.

Call sirala(ActiveSheet.Name)

 

[ant1905]

Dentex selam

Ocak kelimesini ne ile değiştirmem gerekiyor? shname ile değiştirdim çalıştırınca script out of range error verdi

serdar hocam selam

dosya eklemedim çünkü o şekilde devam ediyor aşağı doğru değişiklik yok.

 

[Mehmet Şahin]

Bir şey değiştirmeyeceksiniz. 3 no'lu mesajdaki makroyu bir modüle kopyalayıp, ilgili sayfalara buton koyup bu butonlara test makro'sunu atayacaksınız.

 

[ant1905]

Dentex sorun çözüldü çok teşekkür ederim emeğine sağlık hocam

 

[Mehmet Şahin]

Rica ederim, iyi akşamlar.