kopyala yapıştır

[sel45]

arkadaşlar ekte dosya gönderdim. a.b.c.d sütununa veri girip kopyala butonuna bastığımda f.g.h.ı sütularında dolu hücrenin hemen altındaki boş hücrelere kopyala yapıştır yapsın .cevaplarınız için teşekkür ederim.

 

[AdemCan]

A - D sütununda son kayıt edilen veriyi, F sütunundaki ilk boş hücreye kopyalar.

sonA = Range("A" & Rows.Count).End(xlUp).Row
sonF = Range("F" & Rows.Count).End(xlUp).Row + 1
Range(Cells(sonA, "A"), Cells(sonA, "D")).Copy Cells(sonF, "F")

-------------------------------------------------------------------------------
Alternatif olarak;
Kopyalanan alanı Değer olarak yapıştırmak isterseniz

Application.ScreenUpdating = False
sonA = Range("A" & Rows.Count).End(xlUp).Row
sonF = Range("F" & Rows.Count).End(xlUp).Row + 1
Range(Cells(sonA, "A"), Cells(sonA, "D")).Copy
Cells(sonF, "F").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells(sonA, "A").Select
Application.ScreenUpdating = True

 

[sel45]

A - D sütununda son kayıt edilen veriyi, F sütunundaki ilk boş hücreye kopyalar.

sonA = Range("A" & Rows.Count).End(xlUp).Row
sonF = Range("F" & Rows.Count).End(xlUp).Row + 1
Range(Cells(sonA, "A"), Cells(sonA, "D")).Copy Cells(sonF, "F")

-------------------------------------------------------------------------------
hocam A-D sütunundaki dolu hücrelerin tamamını F-I sütunundaki ilk boş hücrelere yapıştırsın
yukarıdaki kod sadece en son satırı kopyalıyor

 

[AdemCan]

Döngü ile kopyalama işlemi.
F-I sütunundaki kayıtlı veriler silinmeyecek ise Range(Cells(2, "F"), Cells(Rows.Count, "I")).ClearContents bu satırı silebilirsiniz.

Application.ScreenUpdating = False
Range(Cells(2, "F"), Cells(Rows.Count, "I")).ClearContents
sonF = Range("F" & Rows.Count).End(xlUp).Row + 1
For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
     Range(Cells(x, "A"), Cells(x, "D")).Copy
     Cells(sonF, "F").PasteSpecial Paste:=xlPasteValues
     Application.CutCopyMode = False
     If Cells(x, "A").Value <> "" Then sonF = sonF + 1
Next x
Cells(Rows.Count, "A").End(xlUp).Select
Application.ScreenUpdating = True

 

[Seyit Tiken]

Bu şekilde deneyebilirsiniz.

[A1:d10].Copy Destination:=[F65000].End(3).Offset(1)

 

[sel45]

çok teşekkürler hocam elinize sağlık


Application.ScreenUpdating = False
Range(Cells(2, "F"), Cells(Rows.Count, "I")).ClearContents
sonF = Range("F" & Rows.Count).End(xlUp).Row + 1
For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
Range(Cells(x, "A"), Cells(x, "D")).Copy
Cells(sonF, "F").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
If Cells(x, "A").Value <> "" Then sonF = sonF + 1
Next x
Cells(Rows.Count, "A").End(xlUp).Select
Application.ScreenUpdating = True

 

[AdemCan]

Rica ederim, iyi çalışmalar.