makroda sıralama

[elifyağmur]

Arkadaşlar slm;
Ekte gördügünüz dosyada referans numarasına göre yeni bir çalışma sayfasında önce büyükten küçüğe doğru sıralama daha sonra aynı formatta referans numarası yerine yerleştirme yapmak istiyorum.Bu tahsilat makbuzları yüzlerce olabilmekte,yardımcı olabilirseniz çok sevinirim.Şimdiden teşekkürler

 

[Korhan Ayhan]

Sorunuz çok net değil. Daha detaylı açıklama yapmanız gerekiyor.

 

[elifyağmur]

Korhan Bey;
Öncelikle ilginize teşekkürler.Bizim şirketimizde kullandığımız bir programla tahsilat makbuzu dökmekteyiz ve bu tahsilat makbuzlarıda referans numaraları karışık bir biçimde glmekte,bu referans numaralarını küçükten büyüğe sıralı bir biçimde ve ekte gördüğünüz tahsilat makbuzu formatında almak istiyorum.öncelikle sayfa 1 deki referans numaraları ayrı bir sayfada sıraya dizilecek sonra tahsilat makbuzu formatında referans numarası ve o referans numarasına ait vergi numarası,makbuz numarası v.s. bilgiler aynı formatta sayfa 3 te yer alacak ve bende sayfa3 teki sıralı tahsilat makbuzlarının dökümünü alabilicem.Tekrar teşekkürler yardımlarınız bekliyorum

 

[elifyağmur]

Konuyla ilgili özellikle sevgili moderatörlerden yardım bekliyorum.Eminim sizin için çok kolay olamlı.Kopyalama ve yapıştırma kısmını bile otomatik hale getirsem,benim için çok yararlı olacak...ilginize..

 

[apocalyt]

kodu bir modüle kopyalayın deneyin..

Sub daylight()
Application.ScreenUpdating = False
Sheets(3).Range("a1:z10000").ClearContents
Sheets(1).Range("ab2:ab10000").ClearContents
Set bul = Sheets(1).Cells.Find("*Referans*", , , 1)
If Not bul Is Nothing Then
adr = bul.Address
Do
Set bul = Sheets(1).Cells.FindNext(bul)
a = Mid(bul.Value, 11, 20)
Sheets(1).Cells([ab10000].End(3).Row + 1, "ab") = a
Loop While Not bul Is Nothing And adr <> bul.Address
End If
Sheets(1).Range("ab2:ab10000").Sort key1:=Range("ab2")
For x = 1 To Sheets(1).[ab1000].End(3).Row - 1
Set bul = Sheets(1).Range("a2:z10000").Find("*" & Sheets(1).Cells(x + 1, "ab") & "*", , , 1)
bb = bul.Row
Sheets(1).Range("a" & bul.Row - 19 & ":z" & bul.Row).Copy
Sheets(3).Range("a" & Sheets(3).[a10000].End(3).Row + 3).PasteSpecial (xlPasteAll)
Next x
Sheets(1).Range("ab2:ab10000").ClearContents
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşleminiz bitmiştir.", vbInformation
End Sub