DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub sirala()
On Error Resume Next
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(sat, sut)).Select
Application.Dialogs(39).Show
Range("a1").Select
End Sub
Genel kod bu kod ikinci satırdan başlayıp son satır ve son sutüna kadar olan bölümü büloke edip açılan pencereden gereken krıterleri girmek yeterli
Kod:Sub sirala() On Error Resume Next sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Range(Cells(2, 1), Cells(sat, sut)).Select Application.Dialogs(39).Show Range("a1").Select End Sub
buna uygun olurmu
Sub sirala()
On Error Resume Next
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells([COLOR=red]4[/COLOR], 1), Cells(sat, sut)).Select
Application.Dialogs(39).Show
Range("a1").Select
End Sub
İlginiz İçin Teşekkür Ederim ... Bir tek Sorun Var Sıralama Genişletme Menüsü Gelmeden Otomatik Sıralama Yapabilirmiyim?http://img692.imageshack.us/i/adszsgy.png/
uygun olur kırmızı yeri başlangıç olarak belirliyorum.
Kod:Sub sirala() On Error Resume Next sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Range(Cells([COLOR=red]4[/COLOR], 1), Cells(sat, sut)).Select Application.Dialogs(39).Show Range("a1").Select End Sub