Alfabetik Olarak Alt alta aktar

[sirkülasyon]

Değerli Arkadaşlar;
Bordro sayfasında yer alan kişileri ARŞİV sayfasına alfabetik olarak tek düğme ile alt alta gelecek şekilde formüllü değil metin olarak aktarmam lazım.
Makro konusunda Yardımcı olabilir misiniz?

Teşekkür eder, saygılarımı sunarım.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Aktar()

    Dim Sb As Worksheet, Sa As Worksheet, son_b As Long, son_a As Long
 
    Set Sb = Sheets("Bordro")
    Set Sa = Sheets("ARŞİV")
 
    son_b = WorksheetFunction.Count(Sb.Range("B11:B" & Rows.Count))
    son_a = Sa.Cells(Rows.Count, "B").End(xlUp).Row + 1
    If Sa.Range("C4") = "" Then son_a = 4
 
    Application.ScreenUpdating = False
 
    Sb.Range("B11").Resize(son_b, 32).Copy
    Sa.Cells(son_a, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sa.Cells(son_a, "AH").Resize(son_b, 1) = "2018-6" 'yıl ay ilavesi
 
    son_a = Sa.Cells(Rows.Count, "B").End(xlUp).Row
    Sa.Range("B4:AH" & son_a).Sort Sa.Range("C3"), xlAscending 'AG yerine AH yazıldı.
 
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

 

[sirkülasyon]

Ömer Abi Teşekkür Ederim

 

[sirkülasyon]

Ömer Abi
Aktarma Yaparken ARŞİV AH sütununa Yıl - Ay yazdırabilir miyiz.
Örnek 2018 - 6 gibi

 

[Ömer]

#2 numaralı mesaja ekleme yaptım.

 

[sirkülasyon]

Ömer Abi
İkinci bir zahmet verdirdik hakkınızı helal edin.
Yardımınızı esirgemediğiniz için de teşekkür ederim.
Sağ olasınız