定期将Excel中的关联数据复制到第二张工作表,而主工作表仍处于活动状态以进行数据输入

时间:2018-06-29 21:52:45

标签: excel vba excel-vba

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

不要混淆这个问题,而是以这种方式完成代码的原因是可以将数据输入到始终为屏幕上活动工作表的工作表1上,但数据将定期保存到工作表2中。

Excel语句我需要合并并输出到sheet2上的单元格“ 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

1 个答案:

答案 0 :(得分:2)

尝试一下:

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