Question

我正在尝试将从一个工作表（sheet1）输入的数据复制到另一个工作表（sheet2），然后每次将其每小时保存在Sheet2上的单独一行上。我从每一行中提取唯一的单元格，而不是从sheet1中提取整行，以保存到工作表2中，所有数据都按特定顺序排列，并输出到每个单元格具有一个值的单行中，每次保存时创建新行。就我的使用而言，工作表1始终保持为活动工作表的打开状态，在此处进行更改，并且在保持工作表1不变的情况下，数据将定期保存到工作表2中。在此阶段，我每5秒保存一次，以进行故障排除。

我需要帮助，以便从sheet1大约30行中的唯一单元格中提取值，并将其保存到sheet2上的特定单元格中，而sheet1保持打开并处于活动状态。

到目前为止，我遇到以下问题： 1.当我选择了sheet1并打开时，数据将复制到sheet1上，而不是sheet2上，而不是在主动查看/修改sheet1时，根据需要将其写入sheet2。

到目前为止，这是我的代码：

Option Explicit
Public dTime As Date

Sub ValueStore()
Dim dTime As Date
    Range("A" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("A2").Value
    Range("B" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("B2").Value
    Range("C" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("C2").Value
    Range("D" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("D2").Value
    Range("E" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("E2").Value
    Range("F" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("F2").Value
    Range("G" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("G2").Value
    Range("H" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("H2").Value
    Range("I" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("I2").Value
    Range("J" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("J2").Value
    Range("K" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("K2").Value
    Range("L" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("L2").Value
    Range("M" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("M2").Value
    Range("N" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("N2").Value
    Range("O" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("O2").Value
    Range("P" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("P2").Value
    Range("Q" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("Q2").Value
    Range("R" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("R2").Value
    Range("S" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("S2").Value
    Range("T" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("T2").Value
    Range("U" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("U2").Value
    Range("V" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("V2").Value
    Range("W" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("W2").Value
    Range("X" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("X2").Value
    Range("Y" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("Y2").Value
    Range("Z" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("Z2").Value
Range("AA" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AA2").Value
Range("AB" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AB2").Value
Range("AC" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AC2").Value
Range("AD" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AD2").Value
Range("AE" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AE2").Value


  Call 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

Answer 1

这是您的代码示例，其中进行了添加和更改。

1-创建工作表变量 2-使最后一行成为变量 3-由于您正在写入sheet2，因此请将您的代码放入With - End With语句中 4-确保将ws1变量放在要从

复制的范围的前面

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("A1:A" & lRow).Offset(1).Value = ws1.Range("A2").Value
    Range("B1:B" & lRow).Offset(1).Value = ws1.Range("B2").Value
    Range("C1:C" & lRow).Offset(1).Value = ws1.Range("C2").Value
End With

Excel数据复制+自动保存PT 2

1 个答案: