Tek Butonla İki Sayfaya Birden Kayıt Etme

  • Konuyu başlatan Konuyu başlatan berkbaba
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

berkbaba

Kullanıcı
Katılım
12 Eyl 2019
Mesajlar
469
Excel Versiyonu
Excel 2019
Excel Sürümü
32 Bit
Excel Dili
Türkçe
Çözüm
Diğer klasikleri ekleyeyim.

VBA: 
İndirmek için giriş yapmanız gerekmektedir.
(15 satır)

VBA: 
İndirmek için giriş yapmanız gerekmektedir.
(7 satır)
Tarihe göre sırala Oylamaya göre sırala
Aslında B sütunı için sıralanma olayı yaptırılmıştı :)
Alfabetik olayını diğer forumdaki dosyada eklemeyi unutmuşum.
O dosyayı affabetik yaptırıp buraya ekleyeyim.Konu çok karışıktı ben anlarım ancak bu dosyanın dilinden :)
 
Oyla 0 Olumsuz oyla
Dosyaları bir deneyin.Birisi B sütununa sıra numarasını verme olayı diğer formda anlattığım gibi diğeri ise B dekison satıdan bir öncekinin 1 fazlası.

Alttaki koddaki .Range("B2").End(xlDown).Row B2 yerine C2 yazdım.
Alttaki koddaki .Range("B4").End(xlDown).Row B4 yerine C4 yazdım.

212 ve 222.ci satırlar dolu olduğu için kodlar uzadı.Oraları koda gömüp en sonda o satırlara ekletilebilirdi esasen.
Neyse dosyaları bir deneyin alfabetik sıralamada ekledim.
Kaydetme kodunun biride en altta.

VBA: 
İndirmek için giriş yapmanız gerekmektedir.
(110 satır)
 

Ekli dosyalar

Oyla 0 Olumsuz oyla
Ben size yeteri kadar soru sordum. Yeteri kadar zahmet verdim. Bir daha soru sormaya haya ettim. Yine geldi sizi buldu.
Hakkınızı helal edin. Bu platformda da bir kez daha size sonsuz teşekkür ederim.
Beni ihya ettiniz, Rabbimde sizi ihya etsin
 
Oyla 0 Olumsuz oyla
.Sort.SortFields.Add2 Key:=.Range("C3:C" & sonArsivsatirNo) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
kısmı sarı renk ile hata veriyor. Hata Kodu
"runtime error 438"
object doesn t support this property or method

Büyük ihtimalle
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=.Range("C5:C" & sonBordrosatirNo) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
kısmında da hata verecek ama o kısma geçemediğim için bilmiyorum
 
Oyla 0 Olumsuz oyla
Birkaç kod daha değiştirdim.
Sanırım şimdi tam oldu.

Daha öncede yazmıştım 212 ve 222 satırlar diye onlar silinse bu kadar uğraşılmazdı :)
Ben zaman olunca oralarıda koda ekleyeyim olmazsa.
Ben dosyayı bildiğim için zor çıkıyorum işin içinden başkası bilmediği ,ç,n bu konuya dahil oldum :)
Çekinmenize gerek yok benden yana her zaman anladığım kadarıyla yardım ederim.
 

Ekli dosyalar

Oyla 0 Olumsuz oyla
üstad sana çok zahmet verdim.
her kodunu kendi arşivime aldım. Tek kafamın almadığı

Sub sirala_SiraNoBordro()
Dim son As Long, arr, i As Long
With Sheets(sayfa_Bordo)
son = .Range("C:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If son < 5 Then son = 5
ReDim arr(1 To son, 1 To 1)
For i = 5 To son
arr(i - 4, 1) = i - 4
Next
.Range("B3").Resize(son, 1).Value = arr
End With
Erase arr
End Sub

Bu kodu başka bir dosyamda kullandım. Hoşuma da gitti. Ancak bir türlü ilk satırı tutturamadım.
Bunun gibi aynı işlemi gören bir kod paylaşabilir misin?
 
Oyla 0 Olumsuz oyla
.Range("B3").Resize(son, 1).Value = arr

Yukarıdaki 3 yerine 5 gelecekti.Son dosyada değiştirmiştim aslında.
Alternatifte var fakat bu hızlı ideal.
 
Oyla 0 Olumsuz oyla
Alttaki koduda sabit tanımlayıp açıklamalarını ekledim.
Arşiv sayfası içinde aynı mantık.Örnek orda 5 yerine 3 olacak.Klasik yöntemleride eklerim.

VBA: 
İndirmek için giriş yapmanız gerekmektedir.
(18 satır)
 
Oyla 0 Olumsuz oyla
Klasik yöntem1
Alttaki Const ilkBos As Integer = 5 yeri silip ilkBos yerlerinede 5 yazabilirsiniz.

VBA: 
İndirmek için giriş yapmanız gerekmektedir.
(17 satır)
 
Oyla 0 Olumsuz oyla
Diğer klasikleri ekleyeyim.

VBA: 
İndirmek için giriş yapmanız gerekmektedir.
(15 satır)

VBA: 
İndirmek için giriş yapmanız gerekmektedir.
(17 satır)
 
Oyla 0 Olumsuz oyla
Çözüm
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst Alt