Verileri ilgili sayfaya taşımak için makro

[erdemess]

Arkadaşlar sorunum ekteki dosyada yer alan tablodaki verileri benzer formda değer olarak diğer sayfaya aktarıp sonra veri girişinin yapıldığı sayfada formül olmayan hücrelerin silinmesidir. Benim yaptığım makroda ikinci kopyalama işleminde veriler boş satırdan devam etmiyor tekrar yazılı hücrelerin üzerine kopyalanıyor.
Bu sebeple dosyamın ilk halini yükledim, yardımınızı bekliyorum.

 

[Ömer]

Merhaba,

Sub Hesapla()
 
    Dim Sy As Worksheet, sone As Long, sony As Long
    
    Set Sy = Sheets("E_B_veri_sayfası")
    
    Application.ScreenUpdating = False
    Sheets("Eski Boyahane Veri Giriş").Select
    
    If Range("A8") = "" Then Exit Sub
    
    sone = Cells(Rows.Count, "A").End(xlUp).Row
    sony = Sy.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    Range("A8:Y" & sone).Copy
    Sy.Range("A" & sony).PasteSpecial xlPasteValues, xlNone
    Application.CutCopyMode = False
    
    Range("A8:Y" & sone).SpecialCells(xlCellTypeConstants, 23).ClearContents
 
End Sub

Bu şekilde deneyin.

.

 

[Civan Jack]

Sub Sayfaya_Kopyala()
    Dim son As Integer
    Dim formul As Range
    son = Range("A65536").End(3).Row
    Range("A8:Y" & son).Copy
    Sayfa2.Range("A65536").End(3)(2, 1).PasteSpecial xlValues
    Application.CutCopyMode = False
    For Each formul In Range("A8:Y" & son).SpecialCells(xlCellTypeConstants)
        If formul.HasFormula = False Then
           formul.ClearContents
        End If
    Next formul
    Set formul = Nothing
    son = Empty
End Sub

 

[erdemess]

Teeşekkürler

Civan Bey çok teşekkür ederim ilgilendiğiniz için.

 

[erdemess]

Ömer Bey çok teşekkür ederim ilgilendiğiniz için.