excel vba 在最后一个空行上从 sheet1 剪切并过去到 sheet2

Question

我不明白为什么这段代码不起作用。在 sheet1 上，它从第二行选择直到最后一行不为空并剪切。在 sheet2 上，它转到第一个空行，有些出于某种原因，它没有粘贴。 :-(

Sub Macro1()

     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual
     Application.EnableEvents = False
     
     Application.CutCopyMode = False
     
     ThisWorkbook.Sheets("Protocolo diário").Activate
     ActiveSheet.Rows("2:2").Select
     Range(Selection, Selection.End(xlDown)).Cut
    
     ThisWorkbook.Sheets("Protocolo geral").Activate
     ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
     Selection.PasteSpecial xlPasteValues
     
     Application.CutCopyMode = False
     
     ThisWorkbook.Sheets("Protocolo diário").Rows("2:" & Rows.Count).ClearContents
     
     Application.CutCopyMode = False
     
     Application.ScreenUpdating = True
     Application.Calculation = xlCalculationAutomatic
     Application.EnableEvents = True
    
End Sub

Answer 1

备份（'Cut'）行

Option Explicit

Sub backupData()

     Dim wb As Workbook: Set wb = ThisWorkbook
     
     Dim sws As Worksheet: Set sws = wb.Worksheets("Protocolo diário")
     Dim sLastRow As Long: sLastRow = sws.Cells(sws.Rows.Count, 1).End(xlUp).Row
     Dim srg As Range: Set srg = sws.Rows(2).Resize(sLastRow - 1)
     
     Dim dws As Worksheet: Set dws = wb.Worksheets("Protocolo geral")
     Dim dLastRow As Long: dLastRow = dws.Cells(dws.Rows.Count, 1).End(xlUp).Row
     Dim drg As Range: Set drg = dws.Rows(dLastRow + 1).Resize(srg.Rows.Count)
     
     drg.Value = srg.Value
     srg.ClearContents
     ' or maybe:
     'srg.Delete

End Sub

excel vba 在最后一个空行上从 sheet1 剪切并过去到 sheet2

excel vba cut from sheet1 and past to sheet2 on last empty row

excel

vba

paste

备份（'Cut'）行