Soru Aktar

[sirkülasyon]

Geceniz mübarek ola
OnayForm sayfasında bulunan veriler asıl dosyasında formülle alınan veriler. OnayForm sayfasındaki formülleri de silmeden Bu verileri ARŞİV sayfasına formülsüz bir şekilde aktardıkça alfabetik olarak alt alta kayıt edecek. Makro koduna ihtiyacım var. Rica etsem yardım edebilir misiniz?

 

[Korhan Ayhan]

Deneyiniz.

Artık bu tarz basit kodlamaları kendinizin yapabiliyor olması gerekir diye düşünüyorum.

Option Explicit

Sub Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("OnayForm")
    Set S2 = Sheets("ARŞİV")
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    
    If Son > 2 Then
        S1.Range("B3:R" & Son).Copy
        With S2.Cells(S2.Rows.Count, 2).End(3)(2, 1)
            .PasteSpecial xlValues
            .PasteSpecial xlFormats
        End With
        S2.Range("B3:R" & S2.Rows.Count).Sort S2.Range("B3"), xlAscending
        S2.Select
        S2.Range("A1").Select
        S1.Select
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        MsgBox "Veri aktarımı tamamlanmıştır.", vbInformation
    Else
        Application.ScreenUpdating = True
        MsgBox "Aktarılacak veri bulunamadı!", vbExclamation
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
End Sub