Xin hướng dẫn cách cắt tự động 1 hoặc nhiều dòng từ sheet này sang sheet khác (4 người xem)

[xuan.nguyen82]

Không biết có ai hỏi chủ đề này chưa? nhưng mình mạo muội gửi lên đây để nhờ các bạn giải đáp giùm: Bạn mình hỏi mà mình không trả lời được.

Mình có bảng tính dữ liệu gồm 2 sheet, như file đính kèm. Khi ở sheet 1 nếu có dòng nào màu vàng, làm thế nào mà mình chỉ cần đánh dấu X vào cột ghi chú ở sheet 1 (DS nhân viên) mà dòng đó tự động bị cắt và chuyển sang sheet 2 (nghỉ việc) và được đặt ở đúng ở dòng 6 của DS bên sheet nghỉ việc không?
Ví dụ cụ thể ở file này, mình muốn cắt dòng 4 của bảng tính của sheet 1 (bôi màu vàng), sang dòng 6 của bảng tính của sheet 2.
Cảm ơn các bạn rất nhiều!

 

[hoamattroicoi]

Không biết có ai hỏi chủ đề này chưa? nhưng mình mạo muội gửi lên đây để nhờ các bạn giải đáp giùm: Bạn mình hỏi mà mình không trả lời được.

Mình có bảng tính dữ liệu gồm 2 sheet, như file đính kèm. Khi ở sheet 1 nếu có dòng nào màu vàng, làm thế nào mà mình chỉ cần đánh dấu X vào cột ghi chú ở sheet 1 (DS nhân viên) mà dòng đó tự động bị cắt và chuyển sang sheet 2 (nghỉ việc) và được đặt ở đúng ở dòng 6 của DS bên sheet nghỉ việc không?
Cảm ơn các bạn rất nhiều!

Chị đưa fie đính kèm lên nhé và chỉ rõ cho mọi người biết chị muốn cắt dòng nào và chuyển sang đâu. Chị nói cắt dòng thứ 6 bên sheet1 sang sheet nghỉ việc nhưng 6 là tính từ đâu, từ tiêu đề hay từ dòng 1 của bảng tính???
Nếu chỉ mô tả thế này mọi người sẽ rất khó hình dung vì cũng chưa biết được trong file của chị cách bố trí dữ liệu thế nào, các dòng đó có chứa merge cells hay không thì mới đưa ra phương án xử lý giúp bạn chị được.
Thanks!

 

[xuan.nguyen82]

Chị đưa fie đính kèm lên nhé và chỉ rõ cho mọi người biết chị muốn cắt dòng nào và chuyển sang đâu. Chị nói cắt dòng thứ 6 bên sheet1 sang sheet nghỉ việc nhưng 6 là tính từ đâu, từ tiêu đề hay từ dòng 1 của bảng tính???
Nếu chỉ mô tả thế này mọi người sẽ rất khó hình dung vì cũng chưa biết được trong file của chị cách bố trí dữ liệu thế nào, các dòng đó có chứa merge cells hay không thì mới đưa ra phương án xử lý giúp bạn chị được.
Thanks!

Chị đã đưa file và chỉnh sửa nội dung yêu cầu.
Thank em!

 

[hoamattroicoi]

Chị đã đưa file và chỉnh sửa nội dung yêu cầu.
Thank em!

Em nghĩ chắc bạn chị muốn khi tích dấu "x" vào cột ghi chú bằng với việc ghi nhận nhân viên đó nghỉ việc và chuyển sang sheet nghiviec, chứ copy 1 dòng bên sheet DSnhanvien sang đúng dòng 6 của sheet kia thì chỉ copy 1 dòng đó thôi à, nếu tích tiếp chữ "x" cho các nhân viên khác thì copy vào đâu???
Chị chạy thử với code này xem được không nhé.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, [D3:D1000]) Is Nothing Then
            If Target.Value = "x" Then
                Target.EntireRow.Copy Sheet2.[B65536].End(xlUp).Offset(1, -1)
                Target.EntireRow.Delete
                Range([B3], [B1000].End(xlUp)).Offset(, -1) = [row(A:A)]
                If Sheet2.[B1000].End(xlUp).Address = "$B$2" Then Exit Sub
                With Sheet2
                    .Range(.[B3], .[B1000].End(xlUp)).Offset(, -1) = [row(A:A)]
                End With
            End If
        End If

End Sub

 

[SA_DQ]

Còn đây là cách thức chuyển nhiều người cùng nghỉ việc 1 lần

Cảm ơn Hướng dương vì file

 

[xuan.nguyen82]

Cảm ơn Hướng dương vì file

Em nghĩ chắc bạn chị muốn khi tích dấu "x" vào cột ghi chú bằng với việc ghi nhận nhân viên đó nghỉ việc và chuyển sang sheet nghiviec, chứ copy 1 dòng bên sheet DSnhanvien sang đúng dòng 6 của sheet kia thì chỉ copy 1 dòng đó thôi à, nếu tích tiếp chữ "x" cho các nhân viên khác thì copy vào đâu???
Chị chạy thử với code này xem được không nhé.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, [D3:D1000]) Is Nothing Then
            If Target.Value = "x" Then
                Target.EntireRow.Copy Sheet2.[B65536].End(xlUp).Offset(1, -1)
                Target.EntireRow.Delete
                Range([B3], [B1000].End(xlUp)).Offset(, -1) = [row(A:A)]
                If Sheet2.[B1000].End(xlUp).Address = "$B$2" Then Exit Sub
                With Sheet2
                    .Range(.[B3], .[B1000].End(xlUp)).Offset(, -1) = [row(A:A)]
                End With
            End If
        End If

End Sub

Cảm ơn sự giúp đỡ nhiệt tình của mọi người. Mình thấy rất hiệu quả trong cả 2 cách của hoamattroicoi và SA-DQ, và có thể áp dụng trong nhiều việc khác có liên quan...
Cảm ơn rất nhiều!

 

[hoamattroicoi]

Cảm ơn sự giúp đỡ nhiệt tình của mọi người. Mình thấy rất hiệu quả trong cả 2 cách của hoamattroicoi và SA-DQ, và có thể áp dụng trong nhiều việc khác có liên quan...
Cảm ơn rất nhiều!

Chị có thể thêm 2 câu lệnh này vào thủ tục trên để tạm tắt sự kiện Worsheet_change nhé. Thanks!

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, [D3:D65536]) Is Nothing Then Exit Sub
  If UCase(Target.Value) <> "X" Then Exit Sub
            
  Application.EnableEvents = False
  Target.EntireRow.Copy Sheet2.[B65536].End(xlUp).Offset(1, -1)
  Target.EntireRow.Delete
  Range([B3], [B65536].End(xlUp)).Offset(, -1) = [row(A:A)]
  If Sheet2.[B65536].End(xlUp).Address = "$B$2" Then Exit Sub
  With Sheet2
      .Range(.[B3], .[B65536].End(xlUp)).Offset(, -1) = [row(A:A)]
  End With
  Application.EnableEvents = True
End Sub

 

[xuan.nguyen82]

Chị có thể thêm 2 câu lệnh này vào thủ tục trên để tạm tắt sự kiện Worsheet_change nhé. Thanks!

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, [D3:D65536]) Is Nothing Then Exit Sub
            
  Application.EnableEvents = False
  Target.EntireRow.Copy Sheet2.[B65536].End(xlUp).Offset(1, -1)
  Target.EntireRow.Delete
  Range([B3], [B65536].End(xlUp)).Offset(, -1) = [row(A:A)]
  If Sheet2.[B65536].End(xlUp).Address = "$B$2" Then Exit Sub
  With Sheet2
      .Range(.[B3], .[B65536].End(xlUp)).Offset(, -1) = [row(A:A)]
  End With
  Application.EnableEvents = True
End Sub

@ Xuannguyen82 - Hum qua diễn đàn dừng để bảo trì đến 1h sáng em mới đc post bài, hic!

Thế kiểu này phải lên "nhật ký ngắn" đọc bài của chị nha...
Cảm ơn em nhiều! Cả câu trả lời của em và của SA_DQ đã giải quyết được vấn đề của bạn chị cũng như 1 số công việc của chị rất có ích.

 

[xuan.nguyen82]

Cảm ơn Hướng dương vì file

Lời giải rất đúng ý mình. Cảm ơn SA_DQ.