Vba 定期将Excel中的连接数据复制到第二个工作表，同时主工作表保持活动状态以进行数据输入

我从Excel中Sheet1的各个单元格中提取数据，并每隔指定的时间段将值复制到Sheet2中某行的特定单元格中。我几乎完成了我的项目，但无法以相同的方式复制连接的数据。如何将以下excel语句合并到代码中，以便将数据从sheet1复制到sheet2上？输出应进入活页2上的单元格AB

不要混淆问题，但以这种方式执行代码的原因是，数据可以输入到活页1上，活页1将始终是屏幕上的活动页，但数据将定期保存到活页2

Excel语句我需要合并并输出到表2上的单元格“AB”：

=CONCATENATE(Sheet1!I9,", ",Sheet1!I10,", ",Sheet1!I11,", ",Sheet1!I12)

当前代码：

Option Explicit
Public dTime As Date

Sub ValueStore()

 Dim dTime As Date

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("Sheet1")
Set ws2 = ActiveWorkbook.Worksheets("Sheet2")

Dim lRow As Long
    lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row

With ws2
    Range("X1:X" & lRow).Offset(1).Value = ws1.Range("F15").Value
    Range("Y1:Y" & lRow).Offset(1).Value = ws1.Range("F14").Value
    Range("Z1:Z" & lRow).Offset(1).Value = ws1.Range("F17").Value
    Range("AA1:AA" & lRow).Offset(1).Value = ws1.Range("F16").Value

End With

    StartTimer1

End Sub


Sub StartTimer1()
    dTime = Now + TimeValue("00:00:05")
    Application.OnTime dTime, "ValueStore", Schedule:=True
End Sub

Sub StopTimer1()
    On Error Resume Next
    Application.OnTime dTime, "ValueStore", Schedule:=False
End Sub

试试这个：

Sub ValueStore()

    Dim dTime As Date, rw As Range

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = ActiveWorkbook.Worksheets("Sheet1")
    Set ws2 = ActiveWorkbook.Worksheets("Sheet2")

    'find the next empty row on ws2
    Set rw = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).EntireRow

    With rw
        ' note the .Range() here is *relative* to rw
        .Range("A1").Value = Now '<< ensure a value is placed in colA....
        .Range("X1").Value = ws1.Range("F15").Value
        .Range("Y1").Value = ws1.Range("F14").Value
        .Range("Z1").Value = ws1.Range("F17").Value
        .Range("AA1").Value = ws1.Range("F16").Value
        'method1 (contiguous vertical range)
        .Range("AB1").Value = Join(Application.Transpose(ws1.Range("I9:I12").Value), ", ")
        'method2 (join individual cells)
        .Range("AB1").Value = Join(Array(ws1.Range("I9"), ws1.Range("I10"), _
                                         ws1.Range("I11"), ws1.Range("I12")), ", ")

    End With

    StartTimer1

End Sub

子值存储（）
Dim dTime作为日期，rw作为范围
将ws1设置为工作表
将ws2设置为工作表
设置ws1=ActiveWorkbook.Worksheets（“Sheet1”）
设置ws2=ActiveWorkbook.Worksheets（“Sheet2”）
'查找ws2上的下一个空行
设置rw=ws2.Cells（Rows.Count，“A”）.End（xlUp）.Offset（1，0）.EntireRow
与rw
'注意这里的.Range（）是相对于rw的
.Range（“A1”）.Value=Now'尝试以下方法：

Sub ValueStore()

    Dim dTime As Date, rw As Range

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = ActiveWorkbook.Worksheets("Sheet1")
    Set ws2 = ActiveWorkbook.Worksheets("Sheet2")

    'find the next empty row on ws2
    Set rw = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).EntireRow

    With rw
        ' note the .Range() here is *relative* to rw
        .Range("A1").Value = Now '<< ensure a value is placed in colA....
        .Range("X1").Value = ws1.Range("F15").Value
        .Range("Y1").Value = ws1.Range("F14").Value
        .Range("Z1").Value = ws1.Range("F17").Value
        .Range("AA1").Value = ws1.Range("F16").Value
        'method1 (contiguous vertical range)
        .Range("AB1").Value = Join(Application.Transpose(ws1.Range("I9:I12").Value), ", ")
        'method2 (join individual cells)
        .Range("AB1").Value = Join(Array(ws1.Range("I9"), ws1.Range("I10"), _
                                         ws1.Range("I11"), ws1.Range("I12")), ", ")

    End With

    StartTimer1

End Sub

子值存储（）
Dim dTime作为日期，rw作为范围
将ws1设置为工作表
将ws2设置为工作表
设置ws1=ActiveWorkbook.Worksheets（“Sheet1”）
设置ws2=ActiveWorkbook.Worksheets（“Sheet2”）
'查找ws2上的下一个空行
设置rw=ws2.Cells（Rows.Count，“A”）.End（xlUp）.Offset（1，0）.EntireRow
与rw
'注意这里的.Range（）是相对于rw的
.范围（“A1”）.Value=Now'您的代码用sheet1中的每个值填充sheet2上的整个列：这是您想要的吗？我试图让它只替换它正在sheet2上写入的当前行，并保留其上列中的其他条目不变。您的代码用sheet1中的每个值填充sheet2上的整个列：这就是您想要的吗想要吗？我试图让它只替换它在sheet2上写的当前行，并保留上面列中的其他条目不变。