Biçim Aktarma

[nuclearist]

İyi akşamlar;
Bir sayfadaki veriyi diğer sayfalara aktarmak için aşağıdaki kodu kullanıyorum.ancak kaynak sayfadaki biçimler (yazı rengi, yönelim, bold vs..) hedef sayfalara aktarılmıyor. bu sorunun üstesinden nasıl gelebilirim?
şimdiden teşekkür ederim.

Private Sub Worksheet_Deactivate()
sonsat = Sheets("VERI").[a65536].End(3).Row
kopya = Range("A1:E" & sonsat).Address
Sheets("MWS").Range("A1:E65536").Clear
Sheets("Hav-Neg").Range("A1:E65536").Clear
Sheets("Cole-Cole").Range("A1:E65536").Clear
Sheets("Debye").Range("A1:E65536").Clear
Sheets("Cole-Davidson").Range("A1:E65536").Clear
Sheets("MWS").Range(kopya).Value = Sheets("VERI").Range(kopya).Value
Sheets("Hav-Neg").Range(kopya).Value = Sheets("VERI").Range(kopya).Value
Sheets("Cole-Cole").Range(kopya).Value = Sheets("VERI").Range(kopya).Value
Sheets("Debye").Range(kopya).Value = Sheets("VERI").Range(kopya).Value
Sheets("Cole-Davidson").Range(kopya).Value = Sheets("VERI").Range(kopya).Value
End Sub

 

[Korhan Ayhan]

Selamlar,

Sizin kodunuzda bulunan "Sheets("MWS").Range(kopya).Value = Sheets("VERI").Range(kopya).Value" satırını aşağıdaki şekilde değiştirip denermisiniz.

Diğer satırlarıda aşağıdaki şekilde siz değiştiriniz.

Sheets("VERI").Range(kopya).Copy Sheets("MWS").Range(kopya)

 

[nuclearist]

sayın Cost Control, verdiin kod "syntax error" mesajı veriyor.

 

[Levent Menteşoğlu]

Aradaki nokta atlanmış.

[LEFT]Sheets("VERI").Range(kopya).Copy Sheets("MWS").Range(kopya)[/LEFT]

 

[Korhan Ayhan]

Selamlar,

Uyarınız ile gerekli düzeltme yapılmıştır.

 

[nuclearist]

üstadlarım harikasınız. çok teşekkür ederim. iyi geceler.

 

[esmehmet]

VERİ

sayın
nuclearist

dosyayı eklermisiniz.

 

[nuclearist]

sayın
nuclearist

dosyayı eklermisiniz.

eklerim tabiiki.zaten bu dosyadaki makro kodlarının pek çoğu bu forumun aktif katılımcılarının sayesinde yazılabildi.

 

[haktem]

Merhaba, benimde buna benzer bir sorunum vardı, aşağıdaki kodda biçim kopyalanmıyor yardımcı olur musunuz?

Teşekkür ederim.

Sub aktar()
sat = Worksheets("05.02.2012").Cells(Rows.Count, "A").End(3).Row + 1
For i = 1 To 13
For j = 1 To 6
Sheets("05.02.2012").Cells(sat, j).Value = Sheets("siparis").Cells(i, j).Value
Next j
sat = sat + 1
Next i
MsgBox "aktarıldı"
End Sub