Copy sheet ứng với lựa chọn checkbox (1 người xem)

[thuanle2311]

Chào anh chị,
Em muốn copy các sheet được chọn trong checkbox sang 1 workbook mới để gửi email
Nhờ anh chị hỗ trợ VBA copy sheet giúp em với ạ


Cảm ơn anh chị nhiều

 

[Quang_Hải]

Chào anh chị,
Em muốn copy các sheet được chọn trong checkbox sang 1 workbook mới để gửi email
Nhờ anh chị hỗ trợ VBA copy sheet giúp em với ạ
View attachment 290617

Cảm ơn anh chị nhiều

Bài này không cần phải code đâu. Chọn sheets cần tách và nhân bản lên thôi

 

[HeSanbi]

Một cách cho bạn tham khảo:

Sub CopyCheckedSheets_Click()
  CopyCheckedSheets Array("check box 1", "check box 2", "check box 3")
End Sub
Private Function CopyCheckedSheets(boxes)
  On Error Resume Next
  Dim sh, ws, a, o, i, z(), k%, c$
  a = boxes
  If Not IsArray(a) Then Exit Function
  Set sh = ActiveSheet
  For Each i In a
    Err.Clear: Set o = sh.CheckBoxes(i)
    If Err = 0 Then
      If o.value = 1 Then
        c = o.caption: Err.Clear: Set ws = Sheets(c)
        If Err = 0 Then k = k + 1: ReDim Preserve z(1 To k): z(k) = c
      End If
    End If
  Next
  If k > 0 Then Sheets(z).Copy
End Function

 

[thuanle2311]

Bài này không cần phải code đâu. Chọn sheets cần tách và nhân bản lên thôi

Dạ tại vì file nhiều sheets, và mỗi lần gửi email sẽ có 1 chọn 1 số sheet trong đó tùy theo mình mong muốn, nên em đang muốn tách theo checkbox mình đang cần

Bài đã được tự động gộp: 25/5/23

Một cách cho bạn tham khảo:

Sub CopyCheckedSheets_Click()
  CopyCheckedSheets Array("check box 1", "check box 2", "check box 3")
End Sub
Private Function CopyCheckedSheets(boxes)
  On Error Resume Next
  Dim sh, ws, a, o, i, z(), k%, c$
  a = boxes
  If Not IsArray(a) Then Exit Function
  Set sh = ActiveSheet
  For Each i In a
    Err.Clear: Set o = sh.CheckBoxes(i)
    If Err = 0 Then
      If o.value = 1 Then
        c = o.caption: Err.Clear: Set ws = Sheets(c)
        If Err = 0 Then k = k + 1: ReDim Preserve z(1 To k): z(k) = c
      End If
    End If
  Next
  If k > 0 Then Sheets(z).Copy
End Function

Em chưa hiểu thực thi như thế nào, nhờ anh hướng dẫn giúp em với. Cảm ơn anh

 

[HeSanbi]

Em chưa hiểu thực thi như thế nào, nhờ anh hướng dẫn giúp em với. Cảm ơn anh

Gán macro CopyCheckedSheets_Click vào nút [Tách Sheet]
Đổi tên các Check box cho đúng với Check box trong trang tính.

 

[thuanle2311]

Gán macro CopyCheckedSheets_Click vào nút [Tách Sheet]
Đổi tên các Check box cho đúng với Check box trong trang tính.

Cảm ơn anh nhiều nhé