Nhờ tạo code lưu dữ liệu

Liên hệ QC

saobekhonglac

Thành viên mới
Tham gia
1/11/08
Bài viết
1,565
Được thích
1,454
Giới tính
Nam
Chào anh/chị.

Em có file excel. Nhờ anh/chị tạo giúp em code sau cho khi em nhập hết dữ liệu vào sheet Nhap1 thì khi em bấm nút Luu thì dữ liệu sẽ được lưu sang dòng 3 của sheet Luu1 (lưu lần lượt từ C1 đến C40 sang A3 đến AN3 của sheet Luu1,sau khi lưu thì dữ liệu sheet Nhap1 vẫn còn vì sheet Nhap1 là công thức lấy dữ liệu từ các sheet khác, khi nhập tiếp dữ liệu thì khi nhấn nút Luu dữ liệu sẽ lưu tiếp xuống dòng thứ 4 bên sheet Luu1), khi bấm nút in thì dữ liệu sheet Nhap1 sẽ được in tại máy in mặc định. Sheet Nhap2 cũng sẽ lưu vào sheet Luu2 tương tự.
Điều kiện để lưu là ô A1 = “OK”. Nếu A1 không phải là “OK” thì sẽ hiện thông báo “kiểm tra lại dữ liệu”
Cám ơn anh/chị.
 

File đính kèm

Cám ơn anh.

Anh sữa thêm giúp em khi bấm lưu thì dữ liệu tại sheet Luu1 sẽ là giá trị (em đang thử dùng công thức tại sheet Nhap1 thì khi lưu dữ liệu bên sheet Luu1 vẫn là công thức).

Mã:
Sub LacMongCoBe()
Dim NameSh As String, LuuSh As String, lr As Long
NameSh = ActiveSheet.Name
LuuSh = "Luu" & Mid(NameSh, 5, 1000) * 1
lr = Sheets(LuuSh).Range("C65000").End(3).Row + 1
    If [A1].Value = "OK" Then
        Range("C1", Range("C65000").End(3)).Copy
        Sheets(LuuSh).Range("A" & lr).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Else
        MsgBox "Kiem tra lai du lieu"
    End If
Application.CutCopyMode = False
End Sub
Mã:
Sub InMongCoBe()
Dim NameSh As String, LuuSh As String, lr As Long
NameSh = ActiveSheet.Name
LuuSh = "Luu" & Mid(NameSh, 5, 1000) * 1
lr = Sheets(LuuSh).Range("C65000").End(3).Row + 1
    Sheets(LuuSh).Range("A1:AN" & lr).PrintOut
End Sub
 
Anh xem giúp em lỗi sau khi em dán code đó vào.

Cám ơn

Mã:
Sub LacMongCoBe()
Dim NameSh As String, LuuSh As String, lr As Long
NameSh = ActiveSheet.Name
LuuSh = "Luu" & Mid(NameSh, 5, 1000) * 1
lr = Sheets(LuuSh).Range("C65000").End(3).Row + 1
    If [A1].Value = "OK" Then
        Range("C1", Range("C65000").End(3)).Copy
        Sheets(LuuSh).Range("A" & lr).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Else
        MsgBox "Kiem tra lai du lieu"
    End If
Application.CutCopyMode = False
End Sub
 

File đính kèm

  • Hai14-09-2015-2.27.33 PM.jpg
    Hai14-09-2015-2.27.33 PM.jpg
    33 KB · Đọc: 63
Mình đứng trên sheet Nhap1 nhưng nó vẫn bị. Anh có thể tách giúp em code lưu giữa nhap1 và nhap2 là 2 code khác nhau được không, dữ vậy sẽ tiện hơn.

Cám ơn

Code trên là đứng tại sheet Nhap1 hoặc Nhap2 để chạy, Sheet mà có chứa cái Shapes bạn đã vẽ......
Lỗi trên là do bạn đứng tại sheet Luu1 hoặc Luu2 chạy đó..............
 
Lỗi là do sheet luu1 mình merge ô a1 và a2. Khi mình xóa A1 & A2 thì nó lưu được nhưng dữ liệu lưu vào bắt đầu là hàng số 2, mình không đổi tên sheet
 
Anh sửa lại giúp em. nếu tách ra từng sheet theo tên sheet thì càng tốt, vì file của em sẽ còn nhiều sheet để lưu nữa. nếu có từng sheet em sẽ copy code làm như tương tự và đổi tên sheet.
Cám ơn anh
 

File đính kèm

Cám ơn anh nhiều.

Em đang nguyên cứu và làm thêm cho hoàn thiện, khi nào không biết em sẽ nhờ anh tiếp.



Mã:
Sub LacMongCoBe()
Dim WsN As Worksheet, WsL As Worksheet, lr As Long
Set WsN = Sheets("[COLOR=#ff0000][B]Nhap1[/B][/COLOR]") 'Tên sheet Nhập
Set WsL = Sheets("[COLOR=#ff0000][B]Luu1[/B][/COLOR]")    'Tên sheet Lưu
lr = WsL.Range("F65000").End(3).Row + 1
    If WsN.[A1].Value = "OK" Then
        WsN.Range("C1", WsN.Range("C65000").End(3)).Copy
        WsL.Range("A" & lr).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Else
        MsgBox "Kiem tra lai du lieu"
    End If
Application.CutCopyMode = False
End Sub

Làm cho bạn code từ sheet Nhap1 -> Sẽ lưu vào sheet có tên là Luu1
Các sheet khác bạn copy và sửa tên sheet chỗ màu đỏ....... Bạn tự nghiên cứu và thay đổi cho đúng.
 
Anh tạo giúp em thêm code in cũng tách ra theo sheet, code để tên sheet nào thì bấm nút in sẽ in ra sheet đó.
Cám ơn anh
 
Chào anh Khương.

Nhờ anh tạo thêm code cập nhât dãy số giúp em sau cho khi em điền số đầu tiền vào ô B2, số cuối cùng bên ô C2 (sheet Cap nhat )thì khi bấm lưu thì dãy số từ 0000001 đến 0050000 sẽ được lưu từ ô B2 đến B50001 bên sheet Day so (khi bấm lưu lần 2 thì dữ liệu sẽ được cập nhật tiếp vào ô B50002 trở xuống dưới). Anh tạo giúp em lưu theo tên sheet luôn nha anh.

Cám ơn anh.

Mã:
Sub InMongCoBe()
    Sheets("[COLOR=#ff0000][B]Luu1[/B][/COLOR]").PrintOut
End Sub
 

File đính kèm

Anh sửa lại giúp em nếu mình cập nhật lần thứ 2 thì dữ liệu sẽ được cập nhật vào ô tiếp theo của lần 1 (code của anh đang cập nhật dữ liệu đè lên dữ liệu lần 1).
Cám ơn anh.

Mã:
Sub CobeMuacot()
Dim i As Long, j As Long, k As Long, z As Long, v As Long
i = Sheet2.[B2].Value * 1
j = Sheet2.[C2].Value * 1
z = j - i + 1
v = i - 1
Application.ScreenUpdating = False
Sheet1.Range("B2:B65000").ClearContents
If i >= j Then Exit Sub
    For k = 1 To z
        v = v + 1
        Sheet1.Range("B" & 1 + k).Value = Format(v, "'0000000")
    Next k
Application.ScreenUpdating = True
End Sub
 
Anh ơi.

Nếu mình lỡ lưu sai thì mình có cách nào xóa không vậy anh. Ví dụ cell C5 trên sheet Nhap1 của em là số nhảy liên tục (không trùng nhau) thì có cách nào khi em gõ lại số trong ô A5 và bấm xóa thì dữ liệu dẽ dò tìm bên cột E của sheet Luu1 (từ dòng 3 trở xuống) và xóa nguyên dòng đó.
VD tại C5 của sheet Nhap1 gõ "A5" va bấm nút xóa thì dữ liệu dòng 3 của sheet Luu1 sẽ được xóa (nếu xóa từ cột F3 đến hết các cột phí sau thì càng tốt).
Cám ơn.

Sub CobeMuacot()
Dim i As Long, j As Long, k As Long, z As Long, v As Long, lr As Long
i = Sheet2.[B2].Value * 1
j = Sheet2.[C2].Value * 1
z = j - i + 1
v = i - 1
lr = Sheet1.Range("B65000").End(3).Row
Application.ScreenUpdating = False
If i >= j Then Exit Sub
For k = 1 To z
v = v + 1
Sheet1.Range("B" & lr + k).Value = Format(v, "'0000000")
Next k
Application.ScreenUpdating = True
End Sub
[/code][/QUOTE]
 

File đính kèm

Có nghĩa là khi lưu dữ liệu phát hiện ra dữ liệu bị sai nên muốn hủy dữ liệu đã lưu dựa vào cell C5 trong sheet Nhap1 (Dữ liệu tại C5 sẽ tăng dần, liên tục và không bao giờ trùng nhau). Ví dụ khi nhập dữ liệu tại C5 = "000001" và bấm lưu thì sẽ lưu vào dòng 3 trong sheet Luu1, sau đó nhập tiếp C5="000002" và bấm lưu thì sẽ lưu vào dòng 4 trong sheet Luu1. Sau đó phát hiện "000002" bị sai và muốn hủy thì sẽ gõ lại C5="000002" sau đó nhấp vào nút xóa thì dữ liệu dòng 4 bên sheet Luu1 sẽ bị xóa (có thể xóa hết dòng hoặc xóa từ F4 đến AN4).
(C5 trong sheet Nhap1 sẽ được lưu vào cột E trong sheet Luu1)
Cám ơn.

Nói chung là không có hiểu mục đích của bạn làm gì. Nhưng nghe mô tả thì chẳng liên quan gì đến topic này cả... Vậy nha!
 
Web KT

Bài viết mới nhất

Back
Top Bottom