Verileri Otomatik Arşivleme

[kurmayy]

Merhabalar....

Benim sorunum kısaca şöyle.12 sheet'ten oluşan bir excel dosyam var bu sayfalar her gün yeni veriler ekleniyor alt,alta eklenerek devam ediyor..Bu excel dosyasına arşiv diye bir sheet daha ekledim.Her gün 1.sayfadan başlayarak 12.sayfaya kadar tüm verileri sırayla buraya arşivlemesini istiyorum...

Yardımlarınız için şimdiden teşekkürlerimi sunuyorum..

 

[Necdet]

Merhaba,

Dosyayı inceleyiniz.

Sub Birlestir()
Dim sa As Worksheet
Dim s1 As Worksheet
Dim i As Integer
Dim SonKayit As Long
Dim SonK As Long
Set sa = Sheets("arşiv")
Application.ScreenUpdating = False
SonK = sa.[A65536].End(3).Row
Range("A2:I" & SonK).ClearContents
For i = 2 To Sheets.Count
    Set s1 = Sheets(i)
    SonKayit = s1.[A65536].End(3).Row
    SonK = sa.[A65536].End(3).Row + 1
    s1.Range("A2:I" & SonKayit).Copy sa.Cells(SonK, "A")
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Tüm Sayfalar Aktarılmıştır...:"
End Sub