移动/粘贴代码无法正常回复

Question

我对VBA用户表格还不熟悉，所以希望这是一个简单的解决方法。

我正在使用此代码将我的条目从同一个工作簿中的一个工作表移动到另一个工作表，但它处理了一些错误。

*我希望它可以在特定的工作表上工作，但它可以在活动工作表上工作。

**我希望在移动条目后它应该自动清除特定的表格（我不知道该怎么做:(）

这是我的代码：

Private Sub CommandButton8_Click() 'Move Button
For Each cell In ThisWorkbook.Sheets("Daily").Range("endRange")
        If IsDate(cell) = True Then
            myEndRow = cell.Row

        End If

    Next cell

    ThisWorkbook.Worksheets("Daily").Range("A2:E10000" & myEndRow).Select
    Selection.Copy
    Sheets("Data").Select

    'Range("A2660").Select
    ThisWorkbook.Worksheets("Data").Range("a99999").End(xlUp).Select
    ActiveCell(2).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
End Sub

以下是该文件的链接： Link

Answer 1

在与按钮关联的代码中的每日工作表中输入以下内容。 请注意我不确定您的测试目的是否有日期。如果您能澄清这一点，我可以相应地修改代码。您不需要数据表中的按钮，因为这是您要复制到的位置。确保此代码仅驻留在与按钮关联的工作表中，即每日，并且不存在于工作簿中的其他位置。

Private Sub CommandButton1_Click() 'Move Button

Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim rangeToCopy As Range

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Daily")
Set wsTarget = wb.Worksheets("Data")

Dim NextRow As Long

NextRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1 'Find next free row in Data sheet

Set rangeToCopy = wsSource.Range("A1").CurrentRegion.Offset(1, 0) 'get current set of rows that have data excluding header in daily sheet

rangeToCopy.Copy wsTarget.Cells(NextRow, "A") 'copy the new data from daily across to the next free row in the data sheet

rangeToCopy.ClearContents 'clear the contents of the daily sheet under the header


End Sub