Copy/Paste VBA 脚本记录器记录错误

Question

一些问题：脚本链接到每分钟运行 Update Data 的表单 ctrl 按钮。这将运行 Copy Data 并复制行 A39:T39 并将该行粘贴到另一个 sheet 中。这就是意图。但它粘贴不正确。需要连续过去，而不是在 A2 中的另一个 sheet 上以时间戳开头的列。 Stop Recording Data 链接到表单 ctrl 按钮以取消 Update Data 但这也不起作用。

    Sub UpdateData()
     Application.OnTime Now + TimeValue("00:01:00"), "UpdateData"
     CopyData
    End Sub
    
    Sub CopyData()
     Dim sht1 As Worksheet, sht2 As Worksheet, cpyRng As Range, logRng As Long
    
     Application.StatusBar = "Recording Dashboard Started"
     Set sht1 = ThisWorkbook.Sheets("Dashboard")
     Set sht2 = ThisWorkbook.Sheets("Log")
     Set cpyRng = sht1.Range("A39:T39")
     logRng = sht2.Cells(2, Columns.Count).End(xlToLeft).Column + 1
     sht2.Range("A2") = Now
     cpyRng.Copy sht2.Cells(2, logRng)
    End Sub
    
    Sub StopRecordingData()
     Application.StatusBar = "Recording Dashboard Stopped"
     Application.OnTime Now + TimeValue("00:01:00"), "UpdateData", False
    End Sub

Answer 1

将此代码放入自己的模块中。要开始记录，请调用 StartRecordingData() 并停止通话 StopRecordingData()

Option Explicit

Dim boolLoggingActive As Boolean
    
    Public Sub StartRecordingData()
     Application.StatusBar = "Recording Dashboard Started"
     boolLoggingActive = True
     UpdateData
    End Sub
    Public Sub StopRecordingData()
     Application.StatusBar = "Recording Dashboard Stopped"
     boolLoggingActive = False
    End Sub

    Private Sub UpdateData()
        If boolLoggingActive = True Then
            Application.OnTime Now + TimeValue("00:01:00"), "UpdateData"
            CopyData
        End If
    End Sub
    
    Private Sub CopyData()
     Dim sht1 As Worksheet, sht2 As Worksheet, cpyRng As Range, logRng As Long
    
     Application.StatusBar = "Recording Dashboard Started"
     Set sht1 = ThisWorkbook.Sheets("Dashboard")
     Set sht2 = ThisWorkbook.Sheets("Log")
     Set cpyRng = sht1.Range("A39:T39")
     
     Dim rngLogTargetBeginningCell As Range
     Set rngLogTargetBeginningCell = sht2.Rows(sht2.Rows.Count).Columns(1).End(xlUp).Offset(1, 0)
     
     rngLogTargetBeginningCell = Now
     Dim rngLastCellSelection As Range
     
     Application.ScreenUpdating = False ' Stop Updating Graphic during data copy
     Set rngLastCellSelection = Selection ' remember the last selection because pasting will change the active cell
     cpyRng.Copy
     rngLogTargetBeginningCell.Offset(0, 1).PasteSpecial xlPasteValues
     Application.CutCopyMode = False ' Remove the copy area marker
     rngLastCellSelection.Select    ' reselect the old cell
     Application.ScreenUpdating = True  ' update graphics again
    End Sub

Copy/Paste VBA 脚本记录器记录错误

Copy/Paste VBA Script Recorder Logs Wrong

arrays

excel

vba

rows