复制-清除行

• • 之前**

• • 之后**

第一节第一节第一节第二节第一节

• • 法典**
• 复制多行时，无论单元格的选定顺序如何，复制行的顺序都与源工作表中的顺序相同。

Sub CopyClearRows()

    ' Constants
    Const SRC_NAME As String = "List"
    Const SRC_FIRST_ROW As String = "B5:N5"
    Const DST_NAME As String = "Logged"
    Const DST_FIRST_CELL As String = "B2"
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    If Not wb Is ActiveWorkbook Then Exit Sub ' workbook not active
    
    ' Source
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
    If Not sws Is ActiveSheet Then Exit Sub ' worksheet not active
    If Not TypeOf Selection Is Range Then Exit Sub ' not a range
    
    Dim surg As Range
    ' Referencing all columns, not just the columns of the used range.
    Set surg = Intersect(Selection.EntireRow, sws.UsedRange)
    If surg Is Nothing Then Exit Sub ' selection rows outside of used range
     
    Dim srg As Range
    With sws.Range(SRC_FIRST_ROW)
        Set srg = Intersect(.Resize(sws.Rows.Count - .Row + 1), surg.EntireRow)
    End With
    If srg Is Nothing Then Exit Sub ' selected cells above given first row
    
    ' Destination
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
    If dws.FilterMode Then dws.ShowAllData
    
    Dim dfCell As Range: Set dfCell = dws.Range(DST_FIRST_CELL)
    With dfCell
        ' Either, not considering cells to the left...
        Dim dlCell As Range: Set dlCell = .Resize(dws.Rows.Count - .Row + 1, _
            dws.Columns.Count - .Column + 1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        ' ... or, also considering cells to the left...
        'Dim dlCell As Range: Set dlCell = .Resize(dws.Rows.Count - .Row + 1) _
            .EntireRow.Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If Not dlCell Is Nothing Then
            Set dfCell = dws.Cells(dlCell.Row + 1, .Column)
        End If
    End With
    
    ' Copy & Clear.
    srg.Copy dfCell
    srg.ClearContents ' (not considering cells to the left or right)

    ' Inform.
    MsgBox "Rows copy-cleared.", vbInformation

End Sub