Sonucu yan sayfada hergün biriken verilerin altına yapıştırmak hk. kod ihtiyacım var

[oussp]

Arkadaşlar merhaba;

Macroyu çalıştırdıktan sonra sonucu hergün bir sayfada alt alta saklamak istiyorum. Yani hergün elde ettiğim veriyi bir öncekini ezmeden altına eklesin, böylece geriye dönüp gün gün hangi verileri aldığımı göreyim istiyorum.
Bu konuda ne gibi bir kod kullanabilirim acaba? Forumda arayıp bulamadım.
Çok teşekkürler şimdiden arkadaşlar.

 

[N.Ziya Hiçdurmaz]

Yanıt

Istediğiniz saat aralığında verilerinizi bir sayfadan diğerine alt alta atar.

Sub AUTO_OPEN()
Application.OnTime Now + TimeValue("00:00:05"), "AKTAR"[COLOR="Magenta"]'saat,dakika,saniye[/COLOR]
End Sub
Sub AKTAR()
Dim S1, S2 As Worksheet
Dim SUT, SON As String
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
For SUT = 1 To S1.Cells(65536, "A").End(3).Row
SON = IIf(S2.[A1] = "", 1, Cells(65536, "A").End(3).Row + 1)
Range(S2.Cells(SON, "A"), S2.Cells(SON, "D")) = Range(S1.Cells(SUT, "A"), S1.Cells(SUT, "D")).Value
Next
Set S1 = Nothing
Set S2 = Nothing
Call AUTO_OPEN
End Sub

 

[oussp]

Auto open'ın anlamı nedir acaba, belirttiğim zamanda dosyayı kendi kendine açıp alt alta kopyalama mı yapıyor? Bu kod çok hoşuma gitti ama tam olarak nasıl çalıştığını anlamadım. Kodun içindeki hangi verileri değiştirerek kendime uyarlayabilirim acaba?

Benim tam olarak ihtiyacım olan şudur: Ekteki todays sayfasındaki veriyi oldies dosyasındaki verinin altına bir satır boşluk bırakarak kopyalasın. Ama bunu otomatik değil de benim atadığım butona basarak yapmak istiyorum yani küçük bir macro yeterli. Teşekkür ederim.

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub AKTAR()
Dim S1, S2 As Worksheet
Dim SUT, SON As String
Application.ScreenUpdating = False
Set S1 = Sheets("todays")
Set S2 = Sheets("oldies")
SUT = S1.Range("A1:B9").Copy
SON = S2.Cells(65536, "H").End(3).Row + 1
S2.Cells(SON, "H").PasteSpecial
S2.Cells(9 + SON, "H") = "_"
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşlem tamam.", vbInformation
Set S1 = Nothing
Set S2 = Nothing
End Sub

 

[oussp]

Aradığım buydu çok teşekkür ederim yardımınız için.