Makro Veri Kopyala Yapıştırda Sıra Sorunu

[ksenios]

Merhaba Arkadaşlar.
Hazırlamış olduğum bir makro kodum var. Ama aşamadığım da 1 sorunum var yardımcı olursanız minnettar kalırım
Aşağıda ki kodda dikkat ederseniz Seçili Hücreyi Sayfa2'te eğer dolu ise 1 satıra yapıştır komutu var. Fakat benim isteğim seçili hücreyi sayfa2 de a4 ve A50 aralığında satır dolu ise bir üste veya alta yapıştırması. listeyi yaptıktan sonra yukarıdan bir veri sildiğimde aşağıya devam ediyor yukarıdaki boşaltılan satırı görmüyor. Lütfen yardımmm

Sub HUCREYIEKLE()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sayfa2
Set s2 = Sayfa1
x = ActiveCell.Row
son = s1.[a65536].End(3).Row + 1
s1.Range("A" & son) = s2.Range("A" & x)
's1.Range("B" & son) = s2.Range("b" & x)
s1.Range("c" & son) = s2.Range("c" & x)
s1.Range("B" & son) = s2.Range("B" & x)
s1.Range("D" & son) = s2.Range("D" & x)
s1.Range("E" & son) = s2.Range("H" & x)
s1.Range("F" & son) = s2.Range("I" & x)
s1.Range("G" & son) = s2.Range("L" & x)
s1.Range("J" & son) = s2.Range("N" & x)
s1.Range("K" & son) = s2.Range("O" & x)
s1.Range("L" & son) = s2.Range("P" & x)
End Sub

 

[relaxim]

Merhaba,

Örnek eklerseniz daha kolay cevap alırsınız. (Dosya yolu ekleyiniz)

 

[ksenios]

Merhaba,

Örnek eklerseniz daha kolay cevap alırsınız. (Dosya yolu ekleyiniz)

Download Data package from June 16th.

Free transfer of up to 6 GB of photos, videos and documents. Send large files via email or a link to share. No registration, no ads, just simple file sharing!

filetransfer.io

linkten indirip bakabilirseniz sevinirim

 

[GursoyC]

Merhaba,
kodunuzda

son = s1.[a65536].End(3).Row + 1

olduğu sürece aradaki boş satırı görmez.
Satır silme yaptığınıza göre sıralamanın bir önemi yok demektir. Bu durumda kodlarınızın sonuna bir sort komutu ekleyerek aradaki boş hücreleri alta alabilirsiniz.
kodlarınızın sonuna bu kodu ekleyiniz.

s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("a3:a50"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With s1.Sort
        .SetRange Range("A3:m50")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

 

[ksenios]

Merhaba,
kodunuzda

son = s1.[a65536].End(3).Row + 1

olduğu sürece aradaki boş satırı görmez.
Satır silme yaptığınıza göre sıralamanın bir önemi yok demektir. Bu durumda kodlarınızın sonuna bir sort komutu ekleyerek aradaki boş hücreleri alta alabilirsiniz.
kodlarınızın sonuna bu kodu ekleyiniz.

s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("a3:a50"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With s1.Sort
        .SetRange Range("A3:m50")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

-------------
Çok Çok teşekkür ediyorum. Minettar kaldım gerçektende. ufak birkaç sorun var sadece onları kendim düzeltmeye çalışacağım. Ama tam istediğim gibi Ellerinize sağlık bilgi ve desteğiniz için tekrar tekrar teşekkürler

 

[GursoyC]

Rica ederim. İyi çalışmalar.

 

[ksenios]

Merhaba,
kodunuzda

son = s1.[a65536].End(3).Row + 1

olduğu sürece aradaki boş satırı görmez.
Satır silme yaptığınıza göre sıralamanın bir önemi yok demektir. Bu durumda kodlarınızın sonuna bir sort komutu ekleyerek aradaki boş hücreleri alta alabilirsiniz.
kodlarınızın sonuna bu kodu ekleyiniz.

s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("a3:a50"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With s1.Sort
        .SetRange Range("A3:m50")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Son bir soru sormak istiyorum. gerçekten çok iyi herşey tamam sadece Order:=xlDescending veya Ascending değil de eklediğim gibi olmasını sağlayabilirmiyim. azalan artan sıralaması yerine yani. bu arada A3:M50 sınırını yine sürekli geçiyor tam denedim

 

[GursoyC]

Son bir soru sormak istiyorum. gerçekten çok iyi herşey tamam sadece Order:=xlDescending veya Ascending değil de eklediğim gibi olmasını sağlayabilirmiyim. azalan artan sıralaması yerine yani. bu arada A3:M50 sınırını yine sürekli geçiyor tam denedim

Bir çeşit time stamp kullanarak yapabilirsiniz.
Ekleme yaptığınız andaki zamanı; Format(Date, "yyyymmdd") şeklinde başka bir kolona yazdırıp o kolonun tarih formatını da saat/dakika işleyecek şekilde ayarlarsanız o kolon üzerinden sort/descending şeklinde kullanarak sizin son ekleme yaptığınız satırın en alta gelmesini sağlayabilirsiniz.

bu arada A3:M50 sınırını yine sürekli geçiyor tam denedim

Bu cümleyi anlamadım.

 

[GursoyC]

Kodunuzun önceden yazdırdığım kısmını silip şunu ekleyin:

    s1.Range("N" & son) = Format(Now, "yyyymmddhhmmss")
    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("N3:N50"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       With s1.Sort
           .SetRange Range("A3:N50")
           .Header = xlNo
           .MatchCase = False
           .Orientation = xlTopToBottom
           .SortMethod = xlPinYin
           .Apply
       End With