tek makroda 3 fonksiyon

[mtdrgn]

Merhabalar.

Yapmak istediğim şu. A B C D sütununu kopyalayıp değerleri yapıştırmak, F sütununa göre sıralamak ve F sütunu 0 ise o satırı komple silmek.

Kopyala-yapıştır makrosunu yazmıştım, buton atamıştım ve bu butonu diğer sayfalara kopyala yapıştırla diğer sekmelere de yapıştırmıştım. Fakat sıralama makrosunu bu şekilde kopyala yapıştır yapamadım. F sütunu 0 ise sil makrosunun örneklerine baktım ama hiç anlamadım.

Bir de gönderdiğim tabloda sadece 3 sekmeyi bıraktım fakat hazırladığım dosyada 17 tane tablo olacak. Bu makroyu 17 sekemeye birden işlem yaptıracak makro oluşturma şansımız var mı?

 

[apocalyt]

meraba;
bu kadar yazı yazmışsınız ama ben ne yapmak istediğinizi anlıyamadım..tam olrak neyi nereye kopyalayıp sıralama yapmak istiyorsunuz?

 

[mtdrgn]

meraba;
bu kadar yazı yazmışsınız ama ben ne yapmak istediğinizi anlıyamadım..tam olrak neyi nereye kopyalayıp sıralama yapmak istiyorsunuz?

Doğru o noktayı yazmayı unutmuşum. Farklı bir yere kopyalamak istemiyorum.

a b c d sütununa normalde başka yerden veri geliyor ben bu sütundaki verileri kopyalayıp yine aynı yere yapıştırmak istiyorum.

Her şey aynı sekmede olacak, başka yere veri aktarımı olmayacak kısaca.

 

[apocalyt]

şunu denermisiniz ?

Sub daylight()
Application.ScreenUpdating = False
For x = 1 To Sheets.Count
ben = Sheets(x).[a50000].End(3).Row
Sheets(x).Range("a2:d" & ben).Copy
Sheets(x).Range("a2").PasteSpecial (xlValues)
Sheets(x).Range("a2:g" & ben).Sort key1:=Sheets(x).Range("f2"), order1:=xlDescending
For y = ben To 2 Step -1
If Sheets(x).Cells(y, "f") = 0 Then
Sheets(x).Rows.Delete shift:=xlUp
End If
Next y
Next x
Application.ScreenUpdating = True
MsgBox "İşleminiz bitmiştir.", vbInformation
End Sub

 

[mtdrgn]

Maalesef hata verdi.

Ve ben kulandığım excel dosyasına eklediğim zaman vba projeleri bu tür dosyalarda kullanılamaz hatası aldım. Ben de makro kaydedilebilen excel dosyası olarak kaydettim. Bunun nedenini anlayamadım.

Bir de kullanırken aklıma geldi. Bu makroyu geçerli sayfada kullanmak sanırım daha iyi olacak. Çünkü başka sekmelerde çok daha farklı formüller olacak.

 

[apocalyt]

mtdrgn gönderdiğiniz resme bir bakın...kodun en sonunda "end sub " ifadesi yok..benim gönderdiğim kodda var ve orda yok..hata almanız çok normal..

 

[mtdrgn]

mtdrgn gönderdiğiniz resme bir bakın...kodun en sonunda "end sub " ifadesi yok..benim gönderdiğim kodda var ve orda yok..hata almanız çok normal..

Çok özür, end sub u ekledim çalıştı. Fakat ben bir hata yaptım. Exceldeki tüm sekmelere uyguladım ama uygulamamsı gereken sekmeler de olacak, o konuyu atladım.

Bu sorunu nasıl çözebilirim? Sadece Geçerli sekmede bu işlemleri yaptırabilir miyim ya da sadece geçerli sekmenin solundaki sekmelere uygula deme şansım var mı?

 

[apocalyt]

örneğin 20 sekmedeb oluşan bir dosyada ilk 10 sekmeye bu maktoyu uygulamak istiyorsunuz.
( 10 uncu sekme dahil).. açılan kutuya 10 yazmanız yeterli olcaktır..

Sub daylight()
Application.ScreenUpdating = False
sen = InputBox("Kaçıncı sekmeye kadar uygulamak istiyorsunuz?")
For x = 1 To sen
ben = Sheets(x).[a50000].End(3).Row
Sheets(x).Range("a2:d" & ben).Copy
Sheets(x).Range("a2").PasteSpecial (xlValues)
Sheets(x).Range("a2:g" & ben).Sort key1:=Sheets(x).Range("f2"), order1:=xlDescending
For y = ben To 2 Step -1
If Sheets(x).Cells(y, "f") = 0 Then
Sheets(x).Rows.Delete shift:=xlUp
End If
Next y
Next x
Application.ScreenUpdating = True
MsgBox "İşleminiz bitmiştir.", vbInformation
End Sub

 

[mtdrgn]

örneğin 20 sekmedeb oluşan bir dosyada ilk 10 sekmeye bu maktoyu uygulamak istiyorsunuz.
( 10 uncu sekme dahil).. açılan kutuya 10 yazmanız yeterli olcaktır..

Sub daylight()
Application.ScreenUpdating = False
sen = InputBox("Kaçıncı sekmeye kadar uygulamak istiyorsunuz?")
For x = 1 To sen
ben = Sheets(x).[a50000].End(3).Row
Sheets(x).Range("a2:d" & ben).Copy
Sheets(x).Range("a2").PasteSpecial (xlValues)
Sheets(x).Range("a2:g" & ben).Sort key1:=Sheets(x).Range("f2"), order1:=xlDescending
For y = ben To 2 Step -1
If Sheets(x).Cells(y, "f") = 0 Then
Sheets(x).Rows.Delete shift:=xlUp
End If
Next y
Next x
Application.ScreenUpdating = True
MsgBox "İşleminiz bitmiştir.", vbInformation
End Sub

Harika olmuş, eline sağlık. Fakat dosyayı kaydet dediğimde şu iletiyi alıyorum. Bunun nedeni hakkında bir bilgin var mı? Dosyayı ne olarak kaydetmem gerekiyor?

 

[apocalyt]

rica ederim..
yukarıda dediğiniz gibi dosyayı "makro içerebilen excel dosyası" olarak kaydetmeniz gerekiyo..bir defaya mahsus..bir daha böle bir ileti almıcaksınız.

 

[mtdrgn]

rica ederim..
yukarıda dediğiniz gibi dosyayı "makro içerebilen excel dosyası" olarak kaydetmeniz gerekiyo..bir defaya mahsus..bir daha böle bir ileti almıcaksınız.

Çok teşekkürler yardımların için.