复制和粘贴特殊值，即转置值以粘贴到另一个工作表的下一个可用行

Question

我需要

• 从我的“Scrubber”表中的 M 列复制数据
• 张贴到我的“案例日志”表上的下一个打开的行（在这种情况下，它将是金色的第 3 行，但每次都需要这个到下一行）
• 清除我的“Scrubber”工作表数据 (A:D)

Sub CCRS()
    Range("M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Case Log").Select
    Range("F4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=True
    Sheets("Daily Scrubber").Select
    ActiveWindow.SmallScroll Down:=-63
    Range("D2").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub

案例记录表

洗涤纸

Answer 1

复制-转置列范围

Option Explicit

Sub CCRS()
    
    ' Source
    Const sName As String = "Daily Scrubber"
    Const sCopyFirstCellAddress As String = "M2" ' column
    Const sClearFirstCellAddress As String = "A2"
    Const sClearColumnsCount As Long = 4
    ' Destination
    Const dName As String = "Case Log"
    Const dFirstCellAddress As String = "F2" ' row
    ' Both
    Const DataSize As Long = 7
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sCopyData As Variant
    Dim rng As Range
    
    ' Source
    With wb.Worksheets(sName)
        sCopyData = .Range(sCopyFirstCellAddress).Resize(DataSize).Value ' data
        Set rng = .Range(sClearFirstCellAddress) ' first cell
        With rng.CurrentRegion ' clear data (without headers)
            rng.Resize(.Row + .Rows.Count - rng.Row, .Column + .Columns.Count _
                - rng.Column).Resize(, sClearColumnsCount).ClearContents
        End With
    End With
    
    ' Destination
    With wb.Worksheets(dName)
        With .Range(dFirstCellAddress).Resize(, DataSize) ' first row
            Set rng = .Resize(.Worksheet.Rows.Count - .Row + 1) _
                .Find("*", , xlFormulas, , xlByRows, xlPrevious) ' last cell
            If rng Is Nothing Then
                Set rng = .Cells ' no data (no last cell); use first row
            Else
                Set rng = .Offset(rng.Row - .Row + 1) ' first empty row range
            End If
        End With
        rng.Value = Application.Transpose(sCopyData) ' write
    End With
    
    MsgBox "Column copy-transposed.", vbInformation
    
End Sub