Çözüldü Aktif satırı aktarma hk.

[kemal turan]

Merhaba
Aşağıdaki kod ile aktif satırı veritabanına aktarıyorum.
İsteğim değer olarak aktarmak.
Veriler sayfasında hücre biçimlendirme oldukça yoğun.

Set s1 = Sheets("VERILER")
Set s2 = Sheets("VERITABANI")

Dim Say As Long


Say = s2.Cells(Rows.Count, "b").End(3).Row + 1
s2.Range("a" & Say) = Date
s1.Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Copy s2.Range("b" & Say)

MsgBox "İŞLEM TAMAM."

Unload UserForm2

 

[kemal turan]

Merhaba,
Çözümü aşağıdaki kod ile hücre renklendirmeyi kaldırarak çözüme ulaştım.
farklı çözüm olursa teşekkür ederim.

sub aktar ()
Set s1 = Sheets("VERILER")
Set s2 = Sheets("VERITABANI")

Dim Say As Long


Say = s2.Cells(Rows.Count, "b").End(3).Row + 1

s2.Range("a" & Say) = Date
s1.Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Copy s2.Range("b" & Say)
s2.Select
s2.Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
s2.Range("A1").Select
 s1.Select
MsgBox "İŞLEM TAMAM."
end sub

 

[RBozkurt]

Deneyiniz.

    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim Say As Long

    Set s1 = Sheets("VERILER")
    Set s2 = Sheets("VERITABANI")

    Say = s2.Cells(Rows.Count, "b").End(xlUp).Row + 1
    s2.Range("a" & Say).Value = Date
    s2.Range("b" & Say & ":s" & Say).Value = s1.Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Value
    MsgBox "İŞLEM TAMAM."

    Unload UserForm2

 

[kemal turan]

Çok teşekkür ederim.
Selametle kalınız.

 

[RBozkurt]

Çok teşekkür ederim.
Selametle kalınız.

Teşekkürler, iyi çalışmalar.