saniyeyi dakika yapınca çalışmıyor

[PEPE]

aşağıdaki macroda saniyeyi dakika yapınca çalışmıyor neden olabilir
birde burada sayfa 1 in birinci satırındaki veriler sayfa 2 ye aktarılıyor 2 ci satırını sayfa 3 e aktarabilirmiyim



Sub aktar()
Do
DoEvents
[e1] = Format(Now, "hh:mm:ss")
If Second(Now) = 1 Then c = 0
If Second(Now) = 0 And c = 0 Then
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
s1.Range("a2:d2").Copy
sonsat = s2.[a65536].End(3).Row + 1
s2.Cells(sonsat, "a").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
c = c + 1
End If
Loop
End Sub

 

[Kullanıcı_Adı]

aşağıdaki şekilde düzeltirsen istediğin oluyor.

Sub aktar()
Do
DoEvents
[e1] = Format(Now, "hh:mm:ss")
If Second(Now) = 1 Then c = 0
If Minute(Now) = 0 And Second(Now) = 0 And c = 0 Then
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
s1.Range("a2:d2").Copy
sonsat = s2.[a65536].End(3).Row + 1
s2.Cells(sonsat, "a").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
c = c + 1
End If
Loop
End Sub

 

[PEPE]

kimse yok mu, yoksa ben çok zormu soruyorum

 

[PEPE]

tam kimse yokmu dedim beni duydun her halde sağol arkadaşım biliyorsan sorunun ikinci kısmı hakkındada bilgi verirmisin

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:8fea1fb682]Sub aktar()
Do
DoEvents
[e1] = Format(Now, "hh:mm:ss")
If Second(Now) = 1 Then c = 0
If Minute(Now) = 0 And Second(Now) = 0 And c = 0 Then
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
Set s3 = Sheets("sayfa3")
sonsat=s2.[a65536].End(3).Row + 1
s2.range("a" & sonsat & ":d" & sonsat)=s1.Range("a2:d2").value
sonsat2=s3.[a65536].End(3).Row + 1
s3.range("a" & sonsat2 & ":d" & sonsat2)=s1.Range("a2:d2").value
c = c + 1
End If
Loop
End Sub[/vb:1:8fea1fb682]

 

[PEPE]

sayın levent bey teşekkürler yalnız bu makro çalışırken dosya üstünde çalışılmıyor yada makroyu durdurmak gerekiyor

 

[Levent Menteşoğlu]

Evet bu kodlama ile durdurmak gerekir. Bu durumda application.ontime metodunu kullanmak daha iyi netice verecektir.

 

[PEPE]

bu konularda fazla bilgiye sahip değilim konuyu açarsanız sevinirim

 

[PEPE]

AŞAĞIDAKİ GİBİ SİZDEN ALDIĞIM HAZIR BİR application.ontime İLE BİRLEŞTİRDİM AMA BUDA OTAMATİK ÇALIŞMIYOR HER SEFERİNDE BENİM "RUN " DEMEM GEREKİYOR BU KONUDA YARDIMCI OLURMUSUNUZ
GALİBA AYNI SAYFADAKİ SHEETE AKTARDIĞI İÇİN



Dim SaveTime As Date
Private Sub Auto_Close()
ClockRunStop False
End Sub
Private Sub Autpen()
ClockRunStop True
End Sub
Private Sub ClockRunStop(CRS As Boolean)
On Error Resume Next
If CRS Then
SaveTime = Now + TimeValue("00:00:10") 'zaman ayarı 10 sn olarak ayarlıdır
Application.OnTime SaveTime, "SaveMe"
Else
Application.OnTime EarliestTime:=SaveTime, Procedure:="SaveMe", Schedule:=False
End If
End Sub
Sub aktar()
Set s1 = Sheets("veri")
Set s2 = Sheets("adanc")
Set s3 = Sheets("aefes")
sonsat = s2.[a65536].End(3).Row + 1
s2.Range("a" & sonsat & ":d" & sonsat) = s1.Range("a1:j1").Value
sonsat2 = s3.[a65536].End(3).Row + 1
s3.Range("a" & sonsat2 & ":d" & sonsat2) = s1.Range("a2:j2").Value
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin. Bir dakikaya ayarlıdır.

[vb:1:7eee92c594]Dim SaveTime As Date

Private Sub Auto_Close()
ClockRunStop False
End Sub
Private Sub Autpen()
ClockRunStop True
End Sub

Private Sub ClockRunStop(CRS As Boolean)
On Error Resume Next
If CRS Then
SaveTime = Now + TimeValue("00:01:00")
Application.OnTime SaveTime, "SaveMe"
Else
Application.OnTime EarliestTime:=SaveTime, Procedure:="SaveMe", Schedule:=False
End If
End Sub

Private Sub SaveMe()
Set s1 = Sheets("veri")
Set s2 = Sheets("adanc")
Set s3 = Sheets("aefes")
sonsat = s2.[a65536].End(3).Row + 1
s2.Range("a" & sonsat & ":d" & sonsat) = s1.Range("a1:j1").Value
sonsat2 = s3.[a65536].End(3).Row + 1
s3.Range("a" & sonsat2 & ":d" & sonsat2) = s1.Range("a2:j2").Value
ClockRunStop True
End Sub[/vb:1:7eee92c594]