Membuat Penomoran Otomatis dengan Macro Microsoft Excell

Salam..,

Pada Tutorial kali ini tentang pembuatan Penomoran secara otomatis dengan menggunakan Macro pada Microsoft Excell, Penomoran Otomatis ini berdasarkan Kriteria Tanggal, Bulan dan Tahun.
Rancangan yang saya buat adalah proses penerimaan Produk, Saya membuat untuk Nomor Faktur penerimaan secara Automatik.



Berikut ini adalah gambar rancangan Worksheets nya :

 

Tombol / Perintah "Save" digunakan untuk menyimpan Data dari Cell B3:H3 ke Cell B8:H..

Berikut ini Koding Module yang saya gunakan :

Sub Add_Stock()
    On Error GoTo Excell_Faktur:
    'destination range
    Dim RsAddProduct As Range
    Dim wsAddProduct As Worksheet
    'destination variable
    'Set RsAddStock = Worksheets("Sheet1").range("I8")
    Set RsAddProduct = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
    Set wsAddProduct = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    If wsAddProduct.Range("B3") = "" Then
    MsgBox "Please Klik Refres Button"
    Exit Sub
    ElseIf wsAddProduct.Range("C3") = "" Then
    MsgBox "Range Date is Blank"
    Exit Sub
    ElseIf wsAddProduct.Range("D3") = "" Then
    MsgBox "Range Description is Blank"
    Exit Sub
    ElseIf wsAddProduct.Range("E3") = "" Then
    MsgBox "Range Code is Blank"
    Exit Sub
    ElseIf wsAddProduct.Range("F3") = "" Then
    MsgBox "Range Supplier is Blank"
    Exit Sub
    ElseIf wsAddProduct.Range("G3") = "" Then
    MsgBox "Range Qty is Blank"
    Exit Sub
    ElseIf wsAddProduct.Range("H3") = "" Then
    MsgBox "Range Price Unit is Blank"
    Exit Sub
    Else
    'give the user a chance to exit here
    Select Case MsgBox _
    ("You are about to add Data." _
    & vbCrLf & "Check everything before you proceed", _
    vbYesNo Or vbExclamation, "Are you sure?")
    Case vbYes
    Case vbNo
    Exit Sub
    End Select
   
    'copy and paste data without selecting,first sheet,sourse variable
    Set AddProduct = Worksheets("Sheet1").Range("B3:H3")
    AddProduct.Copy
    RsAddProduct.PasteSpecial xlPasteValues
    'empty clipboard
    Application.CutCopyMode = False
    'confirmation message
    MsgBox "Your Data Has Been Added."

    'Clear Cell B3:H3 and make Automatically Number
    Call ref_clear

    wsAddProduct.Select
    Application.ScreenUpdating = True
    End If
    Exit Sub
    Excell_Faktur:
    MsgBox " We have a problem Module"
End Sub

Untuk pembuatan Penomoran otomatis saya buat pada Cell B3 dengan Koding Module yang saya gunakan :

Sub ref_clear()
    On Error Resume Next
    Dim clear As Range
    'range c3:h3 is empty
    Set clear = Worksheets("Sheet1").Range("C3:H3")
    clear.Value = ""
    'cell b3 automatically number
    If Worksheets("Sheet1").Range("B8").Value = "" Then
    Worksheets("Sheet1").Range("B3").Value = "FAK/" & Format(Date, "DDMMYYYY") & "/001"
    Else
    'value cell B3= end range B plus 1
    Worksheets("Sheet1").Range("B3").Value = "FAK/" & Format(Date, "DDMMYYYY") & "/00" & Right(Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Value, 2) + 1
    End If
End Sub

Jika Cell B8 kosong maka Cell B3 = FAK/09022017/001
Bila Cell B8 atau seterusnya sudah terisi maka nilai nya akan ditambahkan 1.

Demikian Tutorial singkat saya untuk pembuatan penomoran otomatis dengan Macro pada Microsoft Excell. Silahkan Sobat kembang kan lagi.

Salam..,