Copy sheet ứng với lựa chọn checkbox

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

thuanle2311

Thành viên mới
Tham gia
5/5/16
Bài viết
3
Được thích
0
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 ạ
1684989654032.png

Cảm ơn anh chị nhiều
 

File đính kèm

  • Tach sheet.xlsx
    18.6 KB · Đọc: 5
Upvote 0
Một cách cho bạn tham khảo:


JavaScript:
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
 
Lần chỉnh sửa cuối:
Upvote 0
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:

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


JavaScript:
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
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom