Seçili Satırın Aktarılması

[igultekin2000]

Merhaba;
Satır seçip, başka çalışma sayfasına aktarabiliyorum. Ancak bazen aynı satır değil de, A2 hücresi ile, B4 hücresi gibi farklı hücre seçerek aktarma işlemi yapmak istiyorum. Bu durumda kullandığım makro hata veriyor. Makroda ne gibi değişiklik yapılması lazımdır. Makro bilgim mevcut üzerinde ufak tefek değişiklik yapacak kadardır. Teşekkür ederim.

Sub kopyala()
Selection.Rows.Copy
a = WorksheetFunction.CountA(Sheets("sayfa4").Columns(1))
Sheets("sayfa4").Cells(a + 1, 1).PasteSpecial
Application.CutCopyMode = False

'Selection.Clear  (seçili alandaki verileri temizliyor)
'Selection.Delete ( seçili satırları , satır olarak siliyor
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Kopyala()
    Dim Sh As Worksheet, Alan As Range, Veri As Range, Satir As Long, Sutun As Integer
    
    Set Sh = Sheets("Sayfa4")
    
    Set Alan = Selection
    
    Satir = Sh.Cells(Sh.Rows.Count, 1).End(3).Row + 1
    Sutun = 1
    
    For Each Veri In Alan
        Sh.Cells(Satir, Sutun).Value = Veri.Value
        Sutun = Sutun + 1
    Next

    Set Alan = Nothing
    Set Sh = Nothing
    
    MsgBox "Veri aktarımı yapılmıştır.", vbInformation
End Sub

 

[igultekin2000]

Deneyiniz.

Teşekkür ederim, makro sorunsuz çalışıyor.