thuanle2311
Thành viên mới
- Tham gia
- 5/5/16
- Bài viết
- 3
- Được thích
- 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ôiChà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
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
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ầnBà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
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 anhMộ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
Gán macro CopyCheckedSheets_Click vào nút [Tách Sheet]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
Cảm ơn anh nhiều nhé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.