Xin giúp đỡ update dữ liệu theo ngày

[domjnjc]

Xin chào các anh/chị trong diễn đàn,

Em có file ví dụ dưới hiện tại phải update dữ liệu thủ công bằng tay như sau:
1. Đầu tiên là em sẽ copy dữ liệu trên web vào cột A thì nó sẽ có dạng dữ liệu theo dạng cột ở sheet form:


2. Sau đó em copy dữ liệu ở sheet sample sang sheet 1 và gán ngày '1/1 vào cột A



Các anh chị giúp em tạo 1 button update được không ạ, tức là sau khi dán dữ liệu vào cột A ở sheet form, ấn nút update thì dữ liệu sẽ update vào sheet trống có số thứ tự nhỏ nhất là 1 và gán ngày update ở cột A là '1/1, tương tự, khi dán một dữ liệu khác vào cột A ở sheet form, ấn update lần nữa thì nó sẽ cập nhật dữ liệu vào sheet tiếp theo, tức là sheet 2 với ngày '2/1 và cứ lần lượt như vậy. Em xin cảm ơn ạ!

 

[bebo021999]

Thủ code này xem sao:

Option Explicit

'--- delete sheets
Sub form_Button2_Click()
Dim ws As Worksheet
If MsgBox("Ban co muon xoa tat ca cac sheet tu 1-31 khong? ", vbYesNo) = vbNo Then Exit Sub
For Each ws In Sheets
    If IsNumeric(ws.Name) Then ws.Delete
Next
End Sub

'---add sheet
Sub ADD()
Dim lr&, i&, j&, k&, st&, max&, rng, res(1 To 10000, 1 To 5)
Dim ws As Worksheet
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A20:A" & lr).Value ' Theo cong thuc mau cua ban thi du lieu muon lay la tu ô A20. Dieu chinh theo thuc te.
For Each ws In Sheets
    If IsNumeric(ws.Name) Then
        If ws.Name > max Then max = ws.Name
    End If
Next
For i = 1 To Int(UBound(rng) / 8) * 8
    st = ((i - 1) Mod 8) + 1
    If st = 1 Then
        k = k + 1
        For j = 1 To 3
            res(k, j + 1) = rng(i + j - 1, 1)
        Next
        res(k, 1) = "'" & max + 1 & "/1": res(k, 5) = rng(i + 5, 1)
    End If
    i = i + 7
Next
Sheets("sample").Copy after:=Sheets("form")
With ActiveSheet
    .Name = max + 1
    .Range("A2:E10000").ClearContents
    .Range("A2").Resize(k, 5).Value = res
End With
Sheets("form").Activate
Range("C1").Select
End Sub