[HELP] - Tách file payment theo form có password (3 người xem)

[subasatran]

Xin chào Anh/Chị/Em GPE
Do như cầu trong công việc mình muốn nhờ mọi người giúp đỡ.
Mình muốn in ra bảng chi tiết lương và gởi về mail cá nhân cho từng người.
Trong file mình gởi có 2 Sheet, một sheet data chứa thông tin chi tiết của nhân viên và một sheet form Payslip của bảng lương.
Giờ mình muốn tách ra form Payslip của từng người với yêu cầu như bên dưới :
+ Tên file, tên sheet sẽ là mã số của nhân viên.
+ File in ra có thể là excel hoặc pdf
+ Nếu tách xong mà có thể đặt luôn password thì thật tuyệt vời(password là mã số của nhân viên).
+ Vì các nhân viên giữ một chức vụ khác nhau nên có thể người này có khoản tiền này mà người kia không có nên khi in bảng lương, những khoản tiền bằng 0 thì sẽ ko được show ra trên payslip.
Mình có làm ví dụ tại file đính kèm cho mọi người dễ hình dung.
Mong mọi người tư vấn và giúp đỡ. Cám ơn rất nhiều.

 

[subasatran]

Rất cảm ơn sự giúp đỡ rất nhiệt tình của hpkhuong. Giải quyết rất gọn . Không biết cảm ơn thế nào

 

[subasatran]

Cho mình hỏi thêm một tí nữa.
Bây giờ nếu chỉ muốn tách ra sheet với các yêu cầu như bên trên thì code phải sửa lại như thế nào vậy ?
Cám ơn rất nhiều.

Đoạn code bên dưới sai ở chỗ nào mà khi chạy vẫn lọc được nhưng những sheet mới đã filter lại ko paste Value được. Thanks

Public Sub GPE()
Dim sArr, I As Long, Path As String
Path = ThisWorkbook.Path
sArr = Sheets("Data").Range("B8", Sheets("Data").Range("B8").End(4)).Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For I = 1 To UBound(sArr)
                               With ActiveWorkbook.Worksheets("Form Payslip")
                              .PageSetup.PrintArea = "$B$2:$D$32"
                              .Range("A2").Value = sArr(I, 1)
                              .Range("B4:D32").AutoFilter 3, "<>0"
                              .Range("B2:D32").SpecialCells(xlCellTypeVisible).Copy
                              .Copy After:=Sheets(Sheets.Count)
                              End With
                              With ActiveSheet
                                   .Name = sArr(I, 1)
                              End With
         Next
       
MsgBox "Done!"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[subasatran]

@hpkhuong : Bạn có thể giúp sửa lại code không tách theo file mà tách theo sheet thôi được ko ?
Cám ơn bạn.

 

[subasatran]

Thanks @hpkhuong rất nhiều.