Запись постоянно меняющихся данных с одного листа на другой лист Excel с помощью кода VBA

Question

Мой код отлично работает для записи данных на другой лист, но не в соответствии с моим требованием.

Dim NextTime As Double
Sub RecordData()
Dim Interval As Double
Dim cel As Range, Capture As Range
Interval = 5    'Number of seconds between each recording of data
Set Capture = Worksheets("Sheet2").Range("A3:C4") 'Capture this column of data
With Worksheets("Sheet1")   'Record the data on this worksheet
Set cel = .Range("A2")  'First timestamp goes here
Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
cel.Value = Now

cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value

End With

NextTime = Now + Interval / 86400
Application.OnTime NextTime, "RecordData"
End Sub

Sub StopRecordingData()
On Error Resume Next
Application.OnTime NextTime, "RecordData", , False
On Error GoTo 0
End Sub

Answer 1

  Dim NextTime As Double
  Sub RecordData()
  Dim Interval As Double
  Dim cel As Range, Capture As Range
  Interval = 5    'Number of seconds between each recording of data
  Set Capture = Worksheets("Sheet1").Range("A3:C4") 'Capture this column of data
  With Worksheets("Sheet2")   'Record the data on this worksheet
  Set cel = .Range("A2")  'First timestamp goes here
  Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
  cel.Resize(Capture.Rows.Count).Value = Now

  cel.Offset(0, 1).Resize(Capture.Rows.Count, Capture.Columns.Count).Value = 
  Capture.Value

  End With

  NextTime = Now + Interval / 86400
  Application.OnTime NextTime, "RecordData"
  End Sub

Sub StopRecordingData()
On Error Resume Next
Application.OnTime NextTime, "RecordData", , False
On Error GoTo 0
End Sub