如何在间隔后记录一张Excel工作表的数据并存储另一张工作表

Question

我为此获得了VBA代码，但无法逐行捕获数据。它仅存储列数据。

Set Capture = Worksheets("Sheet1").Range("A1:C5")

此代码捕获同一行中的数据A1到A5列，然后是B1到B5列，依此类推。但是我试图捕获像是在第一行中首先从A1到C1，然后在下一行捕获A2到C2，依此类推。有什么办法可以加点吗？ Screenshot of the problem

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("A1:C5") '****Problem in this code.Only****
With Worksheets("Sheet2")   'Record the data on this worksheet
Set cel = .Range("A5")  'First timestamp goes here
Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
cel.Value = Now
For i = 1 To 5
cel.Offset(0, 1 + (i - 1) * Capture.Rows.Count).Resize(1, Capture.Rows.Count).Value = 
Application.Transpose(Capture.Columns(i).Value)
Next i

End With

NextTime = Now + Interval / 86400
Application.OnTime NextTime, "RecordData"
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("A2:N2") 'Capture this column of data
With Worksheets("Sheet2")   'Record the data on this worksheet
Set cel = .Range("A5")  '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