求组表格编码自动生成

但为君故沉吟

各位大神们好
我制作了一个简单的收据模版  ，但是收据编码不知道如何设置自动生成！特此求助，希望各位大大能帮帮我，感激不敬！
还有咨询一个问题 ，能否设置成收据开完后，数据信息自动保存的功能！

WANT-T

我把Sheet2的名称改成了Data
我不能上传文件所以把代码贴出来
自己画两个按钮，然后指定宏就好了。
Sub 开单()
    Dim rng As Range
    Set rng = 定位("合计").Offset(-1)
    Range(Range("A5"), Range(rng.Address(0, 0))).Resize(, 6).Select
    Range("B2") = "=NOW()"
    Range("B3") = ""
    Range("D2") = ""
    Range("E2") = "编号：" & Format(Now, "yyyymmddhhmmss")
End Sub
Sub 保存()
Dim Adoconn As Object
Dim StrConn As String, StrSQL As String
Dim Arr(), i As Integer
    If Application.WorksheetFunction.CountIf(Sheets("Data").Range("c:c"), Replace(Sheets("收据").[e2].Text, "编号：", "")) > 0 Then
        MsgBox "亲，您已经保存过了！"
        End
    End If
    Set Adoconn = CreateObject("ADODB.Connection")
    '07
    StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    '03
    'StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=YES"";"
    Adoconn.Open StrConn
    Arr = Range(Range("A5"), Range(定位("合计").Offset(-1).Address(0, 0))).Resize(, 6).Value
    For i = 1 To UBound(Arr)
        StrSQL = Arr(i, 1) & "','" & Arr(i, 2) & "','" & Arr(i, 3) & "','" & Arr(i, 4) & "','" & Arr(i, 5) & "','" & Arr(i, 6)
        StrSQL = "(#" & [b2].Text & "#,'" & [d2].Text & "','" & Replace([e2].Text, "编号：", "") & "','" & [d2].Text & "','" & StrSQL
        StrSQL = StrSQL & "','" & [d3].Text & "','" & 定位("交款人").Offset(, 1).Text & "','" & Replace(定位("操作员").Text, "操作员：", "") & "');"
        StrSQL = "INSERT INTO [data$](收款日期,房间号码,编号,客户名称,费用月份,费用名称,前次读数,本次读数,说明,金额,收款方式,交款人,操作员) VALUES" & StrSQL
        Adoconn.Execute StrSQL
    Next i
    Adoconn.Close
    Set Adoconn = Nothing
    Worksheets("Data").UsedRange.Borders.LineStyle = 1
    MsgBox "数据保存成功！"
End Sub
Function 定位(Str As String) As Range
    Set 定位 = Worksheets("收据").Cells.Find("*" & Str & "*")
    Debug.Print 定位.Address(0, 0)
End Function

WANT-T

我发现不发文件好像不行