Formatıyla veri aktarma

[tamer42]

Merhaba,
Ekli dosyada Sayfa1 de yer alan verileri Kod ile formatıyla birlikte Sayfa2' ye aktarmak istiyorum, yalnız formatını ayarlayamadım

Sayfa1' de yazan bold olmayan örnek: Marketing excl. A&P verisi hücrede sol taraftan bir miktar içerde başlamakta, bu durum nasıl sağlanıyor?

ilginize şimdiden teşekkürler.

iyi Çalışmalar.

 

[Muzaffer Ali]

Merhaba.
Kopyalama yaparsanız biçimler de dahil her şeyi aktarmış olursunuz.

Sub Aktar()
    Sheets("Sayfa1").Range("B2:B12").Copy Sheets("Sayfa2").Range("B2")
End Sub

 

[Necdet]

Merhaba,
Deneyiniz.

Not : Ben neden uzattım ki olayı Muzaffer Bey'in kodları daha kısa, kolon genişlikleri hariç olmak şartıyla.

Sub Aktar()

    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim i As Long
   
    Set sh1 = Sheets("Sayfa1")
    Set sh2 = Sheets("Sayfa2")
   
    i = sh1.Cells(Rows.Count, "B").End(3).Row
   
    sh2.Cells.Clear
   
    sh1.Range("B2:B" & i).Copy
    sh2.Range("B2").PasteSpecial xlPasteAll
    sh2.Range("B2").PasteSpecial xlPasteColumnWidths

    sh2.Activate

End Sub

 

[tamer42]

Merhaba.
Kopyalama yaparsanız biçimler de dahil her şeyi aktarmış olursunuz.

Sub Aktar()
    Sheets("Sayfa1").Range("B2:B12").Copy Sheets("Sayfa2").Range("B2")
End Sub

Hocam ilginize teşekkürler,
Copy-paste olmadan nasıl yapabiliriz?
birde bazı hücreler sol taraftan bir miktar içerde başlamakta, bu durum nasıl sağlanıyor?

 

[Muzaffer Ali]

O zaman aşağıdaki kodu deneyin.

Sub test()
    Dim Bak As Long
    Dim syf1 As Worksheet, syf2 As Worksheet
    Set syf1 = Worksheets("Sayfa1")
    Set syf2 = Worksheets("Sayfa2")
    For Bak = 2 To syf1.Cells(Rows.Count, "B").End(xlUp).Row
        syf2.Cells(Bak, "B") = syf1.Cells(Bak, "B")
        With syf2.Cells(Bak, "B")
            .HorizontalAlignment = syf1.Cells(Bak, "B").HorizontalAlignment
            .VerticalAlignment = syf1.Cells(Bak, "B").VerticalAlignment
            .WrapText = syf1.Cells(Bak, "B").WrapText
            .Orientation = syf1.Cells(Bak, "B").Orientation
            .AddIndent = syf1.Cells(Bak, "B").AddIndent
            .IndentLevel = syf1.Cells(Bak, "B").IndentLevel
            .ShrinkToFit = syf1.Cells(Bak, "B").ShrinkToFit
            .ReadingOrder = syf1.Cells(Bak, "B").ReadingOrder
            .MergeCells = syf1.Cells(Bak, "B").MergeCells
            .Font.Bold = syf1.Cells(Bak, "B").Font.Bold
        End With
    Next
End Sub

 

[tamer42]

O zaman aşağıdaki kodu deneyin.

Sub test()
    Dim Bak As Long
    Dim syf1 As Worksheet, syf2 As Worksheet
    Set syf1 = Worksheets("Sayfa1")
    Set syf2 = Worksheets("Sayfa2")
    For Bak = 2 To syf1.Cells(Rows.Count, "B").End(xlUp).Row
        syf2.Cells(Bak, "B") = syf1.Cells(Bak, "B")
        With syf2.Cells(Bak, "B")
            .HorizontalAlignment = syf1.Cells(Bak, "B").HorizontalAlignment
            .VerticalAlignment = syf1.Cells(Bak, "B").VerticalAlignment
            .WrapText = syf1.Cells(Bak, "B").WrapText
            .Orientation = syf1.Cells(Bak, "B").Orientation
            .AddIndent = syf1.Cells(Bak, "B").AddIndent
            .IndentLevel = syf1.Cells(Bak, "B").IndentLevel
            .ShrinkToFit = syf1.Cells(Bak, "B").ShrinkToFit
            .ReadingOrder = syf1.Cells(Bak, "B").ReadingOrder
            .MergeCells = syf1.Cells(Bak, "B").MergeCells
            .Font.Bold = syf1.Cells(Bak, "B").Font.Bold
        End With
    Next
End Sub

teşekkürler Hocam