Veri ile birlikte taşınamayan hücre çizgileri

[1Al2Ver]

Merhabalar, "Liste" isimli sayfadan "B" sütunu çift tıklanarak "Rapor" sayfasına veriler taşınıyor, ancak ;
1) Veriler ile beraber çizgiler taşınamıyor,
2) Taşınan veriler "bold" olarak taşınıyor,

bu 2 sorunu halledebilirmiyiz, teşekkür ederim.

 

[Orion1]

Ekli dosyayı inceleyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
Set s1 = Sheets("rapor")
Cancel = True
sat = Target.Row
Range("a5:e" & [a65536].End(3).Row).Interior.ColorIndex = xlNone
sat2 = s1.[a65536].End(3).Row + 1
s1.Cells(sat2, "a") = sat2 - 9
Range(Cells(sat, "B"), Cells(sat, "E")).Copy s1.Range("B" & sat2)
Range("b" & sat & ":e" & sat).Interior.ColorIndex = 37
End Sub

 

[Necdet]

Merhaba,

Bende uğraşmıştım, hemen hemen benzer şeyler.
Kırmızı renkli satırın olması gerekiyor sanırım.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
Set s1 = Sheets("rapor")
Cancel = True
sat = Target.Row
sat2 = s1.[a65536].End(3).Row + 1
[B][COLOR=red]s1.Rows(sat2).Insert[/COLOR][/B]
Range(Cells(sat, "A"), Cells(sat, "E")).Copy s1.Cells(sat2, "A")
s1.Cells(sat2, "a") = sat2 - 9
Range("a5:e" & [a65536].End(3).Row).Interior.ColorIndex = xlNone
Range("b" & sat & ":e" & sat).Interior.ColorIndex = 37
End Sub

 

[1Al2Ver]

Ekli dosyayı inceleyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
Set s1 = Sheets("rapor")
Cancel = True
sat = Target.Row
Range("a5:e" & [a65536].End(3).Row).Interior.ColorIndex = xlNone
sat2 = s1.[a65536].End(3).Row + 1
s1.Cells(sat2, "a") = sat2 - 9
Range(Cells(sat, "B"), Cells(sat, "E")).Copy s1.Range("B" & sat2)
Range("b" & sat & ":e" & sat).Interior.ColorIndex = 37
End Sub

Sayın Orion2, teşekkür ederim, "Liste" sayfasındaki "sıra no" da olan çizgiler taşınmadı, manuel girsem bile "Listeyi Temizle" butonu onu da siliyor, saygılar.

 

[1Al2Ver]

Bende uğraşmıştım, hemen hemen benzer şeyler.
Kırmızı renkli satırın olması gerekiyor sanırım.

[s1.Rows(sat2).Insert

Sayın Yesertener, uğraşınız ve emeğiniz için teşekkür ederim, saygılar