"Gammel" macro og se evt gammelt spørgsmål
http://exp.dk/spm/642054Public RunWhen As Double
Public cRunIntervalSeconds ' one minutes
Public Const cRunWhat = "TheSub"
Public I As Long
Public SlutTid As Date ' NY linie
Sub Pico()
Dim AntalGange As Integer ' NY linie
AntalGange = 70
If I = 0 Then
cRunIntervalSeconds = 1
ElseIf I >= 1 And I < AntalGange Then ' Rettet
cRunIntervalSeconds = 1
Else
cRunIntervalSeconds = 1
End If
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
'----------------------------------------------
If I > 0 Then
SlutTid = Now() + (TimeSerial(0, 0, 1) * ((AntalGange - I) * cRunIntervalSeconds))
Sheets("Ark1").Range("F1") = SlutTid - Now() ' NY linie
End If
'----------------------------------------------
End Sub
Sub TheSub()
If I = 0 Then
Sheets("Ark1").Columns("A:A").ClearContents
End If
I = I + 1
If I > 70 Then
Call StopTimer
Call Flyt
MsgBox "Kopiering slut & data overført"
Exit Sub
End If
Sheets("Ark1").Range("A" & I) = Sheets("Ark1").Range("D1") ' Navn på hovedark
Call Pico
End Sub
Sub StopTimer()
I = 0
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub
Public Sub Flyt()
' ret arknavnet til dit ark
If Sheets("Ark2").Range("A1") = "" Then
A = 1
ElseIf Sheets("Ark2").Range("B1") = "" Then
A = 2
Else
A = Sheets("Ark2").Range("A1").End(xlToRight).Offset(0, 1).Column
End If
Sheets("Ark2").Cells(1, A) = Now()
For pp = 2 To 70
Sheets("Ark2").Cells(pp, A) = Sheets("Ark1").Range("A" & pp - 1).Value
Next
'kopierer N1, N2, N3, P1, P2, P3 fra ark(Sekant)
X = 1
For pp = 73 To 83
Sheets("Ark2").Cells(pp, A) = Sheets("start").Range("C" & X).Value
X = X + 1
Next
End Sub
