Buton ile bir hücreyi başka bir hücreye alt alta kopyalama

[yiito]

Tamam, iş bilgisayarımda asıl dosya. Pazartesi günü paylaşayım. Teşekkür ederim.

 

[yiito]

Örnek dosyanızı aslına uygun olarak formüllü şekilde paylaşırsanız iyi olur. Bende hata vermedi çünkü. Muhtemelen formülsüz olduğundandı. Diğer dediğiniz kolay.

Üstad merhaba tekrar, örnek için bir miktar veri bıraktım alt alta kopyalama konusunda yardımcı olmuştunuz. Ekli dosyada sizin makro bulunmakta.

Selection.SpecialCells(xlCellTypeBlanks).Select

Satırında bug veriyordu. Tarih saat bilgisini otomatik olarak getirecektik ve bir de aktarma yaparken C ve D sütununa "Yok" gelenleri hiç aktarma yapmama şansımız var mı? Sadece karşısına değer gelenler makro sonrasında alt alta kopyalanmış olacak şekilde yapabilir miyiz. Teşekkür ederim.

 

[YUSUF44]

Şu kodları bir deneyin bakalım:

Sub aktar()
    Set s1 = Sheets("Sayfa2")
    Set s2 = Sheets("Sayfa6")
    son = s1.Cells(Rows.Count, "A").End(3).Row
    yeni = s2.Cells(Rows.Count, "A").End(3).Row
    If s2.Cells(yeni, "A") <> "" Then yeni = yeni + 1
    s1.Range("A1:D" & son).Copy: s2.Cells(yeni, "A").PasteSpecial Paste:=xlPasteValues
    s2.Select
    s2.Columns("A:A").Select
    boşluk = s2.Cells(Rows.Count, "A").End(3).Row
    s2.Range("E" & yeni & ":E" & boşluk) = Now
    If WorksheetFunction.CountBlank(s2.Range("A1:A" & boşluk)) > 0 Then
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Application.CutCopyMode = False
        Selection.EntireRow.Delete
    End If
    enson = s2.Cells(Rows.Count, "A").End(3).Row
    For i = enson To 1 Step -1
        If s2.Cells(i, "C") = "Yok" Or s2.Cells(i, "D") = "Yok" Then
            s2.Rows(i).Delete
        End If
    Next
End Sub

 

[yiito]

Üstad, ellerine sağlık, harika!