Kolondaki aynı değerleri bul, listenin sonuna yaz

[hopeful]

Merhaba,


* A kolonunda A2'den başlayarak sayılar ya da kelimeler bulunmaktadır.
* A kolonundaki satır sayısı değişkendir.
* A kolonunda "1" değerlerinin tamamını bulup, yine A kolonunda olacak şekilde listenin sonuna otomatik olarak yazmasını talep ediyorum. A kolonundaki diğer değerler de sırasıyla yazılmış olacak..

Açıklamalı dosya ektedir.
Makro için yardımınızı rica ederim.

 

[unur]

Merhaba;
Listende sıfır değer yoksa, 1 ler en alta gelecekse ve diğer rakamlarının sırasının önemi yoksa sütunu seçip büyükten küçüğe sıralama yapabilirsiniz.

Yok eğer diğer rakamlar olduğu gibi kalacak sadece 1 ler en alta gelecek derseniz konu beni aşar.

Kolay gelsin

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub sonagönder()
    son = Cells(Rows.Count, "A").End(3).Row
    For i = 2 To son
        If Cells(i, "A") = 1 Then
            Cells(i, "A").Cut
            Cells(son + 1, "A").Select
            Selection.Insert Shift:=xlDown
        End If
    Next
            
End Sub

Yalnız bu konuyu excele yeni başlayanlar değil de makro başlığına yazsaydınız daha iyi olurdu.

 

[hopeful]

Aşağıdaki makroyu deneyiniz:

Sub sonagönder()
    son = Cells(Rows.Count, "A").End(3).Row
    For i = 2 To son
        If Cells(i, "A") = 1 Then
            Cells(i, "A").Cut
            Cells(son + 1, "A").Select
            Selection.Insert Shift:=xlDown
        End If
    Next
            
End Sub

Yalnız bu konuyu excele yeni başlayanlar değil de makro başlığına yazsaydınız daha iyi olurdu.

Çok teşekkürler Yusuf Bey,

* A kolonu için yazdığımız makroyu, en son veri girişi yapılmış kolon için nasıl uygulatırız?
* Örneğin, en son veri girişi yapılmış kolonu bulduralım. "B8" hücresinde veri var. "B" kolonu için butona bastığımda makroyu çalıştırsın.
* Eğer; "C8" hücresinde veri varsa, butona bastığımda makroyu "C" kolonu için çalıştırsın.

 

[YUSUF44]

Aşağıdaki gibi deneyin. 8. satırda son dolu olan sütuna göre işlem yapar:

Sub sonagönder()
    sonsütun = Cells(8, Columns.Count).End(xlToLeft).Column
    sonsatır = Cells(Rows.Count, sonsütun).End(3).Row
    For i = 2 To sonsatır
        If Cells(i, sonsütun) = 1 Then
            Cells(i, sonsütun).Cut
            Cells(sonsatır + 1, sonsütun).Select
            Selection.Insert Shift:=xlDown
        End If
    Next
End Sub

 

[hopeful]

Aşağıdaki gibi deneyin. 8. satırda son dolu olan sütuna göre işlem yapar:

Sub sonagönder()
    sonsütun = Cells(8, Columns.Count).End(xlToLeft).Column
    sonsatır = Cells(Rows.Count, sonsütun).End(3).Row
    For i = 2 To sonsatır
        If Cells(i, sonsütun) = 1 Then
            Cells(i, sonsütun).Cut
            Cells(sonsatır + 1, sonsütun).Select
            Selection.Insert Shift:=xlDown
        End If
    Next
End Sub

Çok teşekkürler Yusuf Bey