Aktif satırı alt ilk boş satıra kopyalamak

[EKREM1661]

Çok değerli arkadaşlar..! Herkese selamlar..

Excel sayfasında "A" sutununda sıra numarası verilerek, "B:M" sütunları arasında sırayla satır satır veriler giriliyor..
Girilen veri, bazen aynı (mükerrer) olabiliyor, aynı veriyi tekrar girmektense önceki satırı aşağıya kopyalamak gerekiyor..

Bunun için; satırın her hangi bir hücresini seçip (yani, aktif satır pozisyonunda iken)
Butona tıklamak suretiyle, ilgili satırı en alt ilk boş satıra kopyalamak.."A" sütununda Sıra numarası verdirip tarihini güncelliyerek..

 

[Orion1]

Dosya ekte.

Sub alt_satir()
Dim sat As Long
sat = Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Satır doldu .Başka kayıt yapılamaz..!!", vbCritical, "UYARI"
    Exit Sub
End If
If MsgBox("[ " & ActiveCell.Row & " ] numaralı satıra en alta kopyalamak istiyormusunuz?", vbYesNo + vbInformation, "Kopyala") = vbNo Then Exit Sub
Range(Cells(ActiveCell.Row, "A"), Cells(ActiveCell.Row, "M")).Copy Range("A" & sat)
Range("A" & sat).Value = sat - 1
Range("C" & sat).Value = Date
MsgBox "Kopyalandı.."
End Sub

 

[EKREM1661]

Değerli üstad Evren Bey..! size hakkınızı ödeyemem.. çok güzel olmuş, bundan daha iyisi de olamaz.. (sadece, vaktiniz müsait ise, kopyalanan satırın tarihini de günün tarihine çevirebilirse hiç bir noksanlık kalmamış olacak..)

 

[Orion1]

Değerli üstad Evren Bey..! size hakkınızı ödeyemem.. çok güzel olmuş, bundan daha iyisi de olamaz.. (sadece, vaktiniz müsait ise, kopyalanan satırın tarihini de günün tarihine çevirebilirse hiç bir noksanlık kalmamış olacak..)

Dosyayı 2 numaralı mesajdan indirebilirsiniz.

 

[EKREM1661]

Tüm hayırlı işlerinizde; Allh sizi muvaffak etsin..

 

[Orion1]

Tüm hayırlı işlerinizde; Allh sizi muvaffak etsin..

Amin sizinde.