Private Sub 复制()
Dim idate As String
''''''''获取系统时间''''''''
idate = Date
'''''''''根据“合计”单元格的行数，得到最后一条数据所在的行数'''''''''
i = 1
Do
    If Sheets("***").Range("a" & i) = "合计" Then
    num = i - 1
    Exit Do
    End If
    i = i + 1
Loop
On Error Resume Next
    If ThisWorkbook.Worksheets("***1") Is Nothing Then    //判断是否存在***1表
        '''''''''在文件最后添加sheets'''''''''
        Sheets.Add AFTER:=Sheets(Sheets.Count)
        '''''''''sheets重命名'''''''''
        ActiveSheet.Name = "***1"
        '''''''''数据复制'''''''''
        ThisWorkbook.Worksheets("***").Range("a1:p" & num).copy ThisWorkbook.Worksheets("***1").Range("a1:p" & num)
        '''''''''为每行数据后添加系统时间'''''''''
        For n = 4 To i
            If n = i Then
            Exit For
            Else: ThisWorkbook.Worksheets("***1").Range("p" & n).Value = idate
            End If
        Next n
        '''''修改单元格格式'''''
        Columns("P:P").ColumnWidth = 15.25
        '''''''''''删除按钮'''''''''''
        ActiveSheet.Shapes.Range(Array("Button 1")).Select
        Selection.Delete
        ActiveSheet.Shapes.Range(Array("Button 2")).Select
        Selection.Delete
    Else
        ''''''''''得到最后一行数据的所在行数''''''''''
        j = Sheets("***1").Range("a65536").End(xlUp).Row + 1
        ThisWorkbook.Worksheets("***").Range("a4:p" & num).copy ThisWorkbook.Worksheets("***1").Range("a" & j)
        Max = Sheets("***1").Range("a65536").End(xlUp).Row
        For m = j To Max
            If m = Max + 1 Then
            Exit For
            Else: ThisWorkbook.Worksheets("***1").Range("p" & m).Value = idate
            End If
        Next m
        Columns("P:P").ColumnWidth = 15.25
    End If
    ''''''''''''''清空原表下的数据''''''''''''''
    ThisWorkbook.Worksheets("***").Range("a4:p" & num).ClearContents
    ThisWorkbook.Save
End Sub