Private Sub CommandButton1_Click()
    '创建并设置时间追踪表和主数据表的变量
    Dim TTrk As Worksheet, MDat As Worksheet
    Set TTrk = Sheet1
    Set MDat = Sheet2
    '为时间追踪表中的每个单元格创建并设置变量
    Dim Name As Range, AddDate As Range, TotalHours As Range, Activity As Range, Client As Range, Category As Range, AddHours As Range, TimeSpent As Range, Additional As Range
    Set Name = TTrk.Range("C2")
    Set AddDate = TTrk.Range("C3")
    Set TotalHours = TTrk.Range("C5")
    Set Activity = TTrk.Range("B8:B15")
    Set Client = TTrk.Range("C8:C15")
    Set Category = TTrk.Range("D8:D15")
    Set AddHours = TTrk.Range("E8:E15")
    Set TimeSpent = TTrk.Range("F8:F15")
    Set Additional = TTrk.Range("G8:G15")
    '创建主数据表中粘贴单元格的变量
    Dim DestCell As Range
    If MDat.Range("A2") = "" Then '如果A2为空
        Set DestCell = MDat.Range("A2") '...那么目标单元格是A2
    Else
        Set DestCell = MDat.Range("A1").End(xlDown).Offset(1, 0) '...否则，下一个空行
        If MDat.Range("A2") = "" Then '如果A2为空
            Set DestCell = MDat.Range("A2") '...那么目标单元格是A2
        Else
            Set DestCell = MDat.Range("A1").End(xlDown).Offset(2, 0) '...否则，下一个空行
        End If
    End If
    '从时间追踪表复制并粘贴数据到主数据表
    Name.Copy DestCell
    AddDate.Copy DestCell.Offset(0, 1)
    TotalHours.Copy DestCell.Offset(0, 2)
    Activity.Copy DestCell.Offset(0, 3)
    Client.Copy DestCell.Offset(0, 4)
    Category.Copy DestCell.Offset(0, 5)
    AddHours.Copy DestCell.Offset(0, 6)
    TimeSpent.Copy DestCell.Offset(0, 7)
    Additional.Copy DestCell.Offset(0, 8)
    '清除时间追踪表中的内容
    AddDate.ClearContents
    TotalHours.ClearContents
    Activity.ClearContents
    Client.ClearContents
    Category.ClearContents
    AddHours.ClearContents
    TimeSpent.ClearContents
    Additional.ClearContents
End Sub

将范围侧-by-侧复制
-
**一个快速修复**
- 以以下方式引用目标单元格：
<!-- 语言：lang-vb -->
    Dim DestCell As Range: Set DestCell = MDat.Range("A2")
    
    With MDat.UsedRange
        Dim drOffset As Long:
        drOffset = .Rows(.Rows.Count).Row - DestCell.Row + 1
        If drOffset > 0 Then
            Set DestCell = DestCell.Offset(drOffset)
        End If
    End With
**之前**
[![在这里输入图片描述][1]][1]
**之后**
[![在这里输入图片描述][2]][2]
**一个简化**
<!-- 语言：lang-vb -->
    Private Sub CommandButton1_Click()
        
        Const SRC_RANGES As String = "C2,C3,C5,B8:G15"
        Dim sClearFlags(): sClearFlags = VBA.Array(0, 1, 1, 1)
        Const DST_FIRST_CELL As String = "A2"
        
        Dim sws As Worksheet: Set sws = Sheet1
        Dim dws As Worksheet: Set dws = Sheet2
        
        Dim dfCell As Range: Set dfCell = dws.Range(DST_FIRST_CELL)
        
        With dws.UsedRange
            Dim drOffset As Long: drOffset = .Rows(.Rows.Count).Row - dfCell.Row + 1
            If drOffset > 0 Then
                Set dfCell = dfCell.Offset(drOffset)
            End If
        End With
        
        With sws.Range(SRC_RANGES)
            Dim arg As Range, n As Long
            For Each arg In .Areas
                ' 复制.
                arg.Copy dfCell
                Set dfCell = dfCell.Offset(, arg.Columns.Count)
                ' 清除.
                If sClearFlags(n) = 1 Then
                    arg.ClearContents
                End If
                n = n + 1
            Next arg
        End With
     
    End Sub
  [1]: https://i.stack.imgur.com/qI1HJ.jpg
  [2]: https://i.stack.imgur.com/PLscV.jpg