Aktif satırı kopyalayan kod, biçimini kopyalamasın..

[EKREM1661]

Saygıdeğer Forum Arkadaşlar..! Aşağıdaki kod kalıbı, bir sayfadaki aktif satırı, diğer bir sayfada son satıra (biçimleriyle birlikte) kaydediyor.. Biçim ve çizimleri hariç, sadece veri olarak aktarılmasını nasıl sağlayabiliriz..?

Private Sub CommandButton2_Click()

Dim S1 As Worksheet, s2 As Worksheet
Dim BUL As Range

Set S1 = Sheets("girdi"): Set s2 = Sheets("RepertuvaR")
Set BUL = s2.Range("C:C").Find(What:=ActiveCell.Value, LookIn:=xlValues, LookAt:=xlWhole)

Uyarı = MsgBox("Seçili Satır, RepertuvaR Sayfasına Kaydedilecek..!" & vbCrLf & " " & vbCrLf & "Devam Edilsin mi..?", vbSystemModal + vbInformation + vbYesNo, "UYARI")

If Uyarı = vbYes Then
If Not BUL Is Nothing Then
    MsgBox "Mükerrer oldugu icin kaydedilemez...", vbCritical, "Bilgi"
Exit Sub
End If
Else
Exit Sub
End If

SSat = s2.[C65536].End(3).Row + 1
sat = ActiveCell.Row
Rows(sat & ":" & sat).Copy s2.Range("A" & SSat)
MsgBox ("Seçilen Kayıt RepertuvaR Sayfasına Kopyalanmıştır.!")
s2.Range("A2") = 1
s2.Range("A2").AutoFill Destination:=s2.Range("A2:A" & s2.Range("C" & Rows.Count).End(3).Row), Type:=xlFillSeries

End Sub

 

[Korhan Ayhan]

Sadece değer lazımsa kopyalama işlemine de gerek kalmaz.

Size satırda ki sütun bazında hangi hücre aralığı gerekiyor belirtirseniz kodu revize edebiliriz.

 

[EKREM1661]

Hocam, A : I arasında kalan seçili/aktif satırı buton aracılığı ile "repertuvar" isimli sayfaya kopyalıyorum.. (Ancak satır yüksekliği (24.00) ile satırdaki tablo çizimine ait çizgileri de birlikte kopyalıyor.. Halbuki kopyalanan, sadece arşiv bilgisi için gerekli..) Gerekirse örnek dosyası ile eklerim..

 

[Korhan Ayhan]

Deneyiniz.

s2.Range("A" & SSat & ":I" & SSat).Value = Range("A" & sat & ":I" & sat).Value

 

[EKREM1661]

Korhan hocam, çok teşekkürler..
bendeki bu

Rows(sat & ":" & sat).Copy s2.Range("A" & SSat)

kodun yerine, sizin kod'u yazınca oldu..
Hayırlı geceler dileğiyle..