Tách 1 Sheet Thành Nhiều Sheet Theo điều Kiện | Giải Pháp Excel

Trang chủ » Tách Sheet Theo điều Kiện » Tách 1 Sheet Thành Nhiều Sheet Theo điều Kiện | Giải Pháp Excel

Có thể bạn quan tâm

Giải Pháp Excel
  • Trang chủ Có gì mới Hoạt động gần nhất Tác giả
  • Diễn đàn Tìm bài viết mới Tìm theo chuyên mục
  • Video New Video về Excel Video về tin học khác Tin tức về tin học chung
  • Thông tin mới Featured content Tìm bài mới Tài Nguyên Mới Hoạt động gần nhất
  • Tài nguyên Đánh giá mới nhất Tìm tài nguyên
  • Facebook
  • Đóng góp
Đăng nhập Đăng Ký Có gì mới? Tìm kiếm

Tìm kiếm

Mọi nơi Đề tài Diễn đàn này Đề tài này Chỉ tìm trong tiêu đề Note Bởi: Tìm kiếm Tìm nâng cao…
  • Tìm bài viết mới
  • Tìm theo chuyên mục
Menu Đăng nhập Đăng Ký Install the app Install How to install the app on iOS

Follow along with the video below to see how to install our site as a web app on your home screen.

Note: This feature may not be available in some browsers.

  • Khách ơi! GPE thông tin đến bạn ấn phẩm "lập trình VBA trong Excel": - Phần cơ bản - Phần Nâng Cao - VBA trong Excel - Cải thiện và tăng tốc
  • Trang chủ
  • Diễn đàn
  • Lập Trình với Excel
You are using an out of date browser. It may not display this or other websites correctly.You should upgrade or use an alternative browser. Tách 1 sheet thành nhiều sheet theo điều kiện (1 người xem)
  • Thread starter Thread starter nguyendinhtutw
  • Ngày gửi Ngày gửi 27/6/17
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 2 (Thành viên: 0, Khách: 2) nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam Dear các bác, Em có 1 file excel như đính kèm, bây giờ em muốn tách sheet "Tong hop" thành các sheet (tạm gọi là "sheet con") dựa theo tên của người quản lý sao cho: - Khi thay đổi nội dung ở các sheet con (Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo. Các bác giúp em với ạ. Em cảm ơn các bác! Trân trọng,

File đính kèm

  • Sample 1.xlsx Sample 1.xlsx 9.6 KB · Đọc: 104
Sắp xếp theo thời gian sắp xếp theo bầu chọn Hoang2013

Hoang2013

Thành viên gắn bó
Tham gia 15/8/13 Bài viết 1,622 Được thích 1,598 Giới tính Nam Nghề nghiệp Hưu trí Nên chăng tách từ Sheet 'TongHop' vô 1 trang chi tiết; Nhưng thể hiện 'Người quản lí' nào đó mà bạn muốn; Upvote 0 H

haonlh

Thành viên tích cực
Tham gia 2/12/07 Bài viết 1,177 Được thích 587 1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần. 2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau) b. Xóa nội dung của TongHop c. Chép nội dung mọi sheet con về sheet TongHop. Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
haonlh đã viết: 1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần. 2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau) b. Xóa nội dung của TongHop c. Chép nội dung mọi sheet con về sheet TongHop. Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác, bác có thể giúp em đoạn code này không? em cũng đang tìm hiểu trên mạng nhưng em còn quá yếu về VBA nên chưa thể tự làm được việc này. Em cảm ơn! Upvote 0 H

haonlh

Thành viên tích cực
Tham gia 2/12/07 Bài viết 1,177 Được thích 587 OK. Giờ hơi muộn. Lo công việc đã. Có thể tối nay hoặc mai Upvote 0 phuyen89

phuyen89

Thành viên tích cực
Tham gia 20/11/08 Bài viết 875 Được thích 341 Nghề nghiệp Student
haonlh đã viết: 1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần. 2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau) b. Xóa nội dung của TongHop c. Chép nội dung mọi sheet con về sheet TongHop. Nhấp chuột vào đây để mở rộng...
Mục b, và c cứ làm thế thôi, chứ không biết chính xác được sheet con có chỉnh sửa hay không phải không Anh. Upvote 0 phuyen89

phuyen89

Thành viên tích cực
Tham gia 20/11/08 Bài viết 875 Được thích 341 Nghề nghiệp Student
haonlh đã viết: 1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần. 2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau) b. Xóa nội dung của TongHop c. Chép nội dung mọi sheet con về sheet TongHop. Nhấp chuột vào đây để mở rộng...
Mình triển khai ý thứ b và c của Anh. các bạn hỗ trợ ý a nhé. PHP: Sao chép. Private Sub Worksheet_Activate() Dim Wks As Worksheet Range("A3:G10000").ClearContents For Each Wks In Worksheets If Wks.Name <> "Tong hop" Then Wks.Range("A3", Wks.Range("C60000").End(xlUp)).Resize(, 5).Copy Sheets("Tong hop").Range("C60000").End(xlUp).Offset(1, -2).PasteSpecial xlPasteValues End If Next Wks End Sub

File đính kèm

  • Copy of Sample 1.xlsb Copy of Sample 1.xlsb 18 KB · Đọc: 126
Upvote 0 phuyen89

phuyen89

Thành viên tích cực
Tham gia 20/11/08 Bài viết 875 Được thích 341 Nghề nghiệp Student
nguyendinhtutw đã viết: Dear các bác, Em có 1 file excel như đính kèm, bây giờ em muốn tách sheet "Tong hop" thành các sheet (tạm gọi là "sheet con") dựa theo tên của người quản lý sao cho: - Khi thay đổi nội dung ở các sheet con (Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo. Các bác giúp em với ạ. Em cảm ơn các bác! Trân trọng, Nhấp chuột vào đây để mở rộng...
Mình tách ra như File đính kèm. Code em viết còn lung tung quá, các anh chị giúp em thay đổi với. Ý tưởng của Em thế này. - Em cho cột Họ và Tên vào 1 đối tượng Dictionary - Em duyệt một mảng lấy từng dòng họ và Tên so với Họ và tên đã lưu trong Dictionary - Sau khi so ra kết quả, Em Add vào một mảng mới - Add new sheet, để dán cái mảng đó xuống bảng tính. Mã: Sao chép. Sub SplitSheet() Dim Dic As New Dictionary Dim sFullName(), dFullName() Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer sFullName = Sheets("Tonghop").Range("A3:G20").Value ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2)) '---------------------------------------------------------------------- For i = 1 To UBound(sFullName, 1) If Not Dic.Exists(sFullName(i, 3)) Then Dic.Add sFullName(i, 3), "" End If Next i '---------------------------------------------------------------------- For j = 1 To Dic.Count For k = 1 To UBound(sFullName, 1) If sFullName(k, 3) = Dic.Keys()(j - 1) Then m = m + 1 For n = 1 To 7 dFullName(m, n) = sFullName(k, n) Next n End If Next k Worksheets.Add After:=Sheets("Tonghop") ActiveSheet.Range("A3").Resize(18, 7) = dFullName ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2)) k = 0: m = 0: n = 0 Next j End Sub

File đính kèm

  • Sample 1.xlsb Sample 1.xlsb 23.3 KB · Đọc: 99
Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
phuyen89 đã viết: Mình tách ra như File đính kèm. Code em viết còn lung tung quá, các anh chị giúp em thay đổi với. Ý tưởng của Em thế này. - Em cho cột Họ và Tên vào 1 đối tượng Dictionary - Em duyệt một mảng lấy từng dòng họ và Tên so với Họ và tên đã lưu trong Dictionary - Sau khi so ra kết quả, Em Add vào một mảng mới - Add new sheet, để dán cái mảng đó xuống bảng tính. Mã: Sao chép. Sub SplitSheet() Dim Dic As New Dictionary Dim sFullName(), dFullName() Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer sFullName = Sheets("Tonghop").Range("A3:G20").Value ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2)) '---------------------------------------------------------------------- For i = 1 To UBound(sFullName, 1) If Not Dic.Exists(sFullName(i, 3)) Then Dic.Add sFullName(i, 3), "" End If Next i '---------------------------------------------------------------------- For j = 1 To Dic.Count For k = 1 To UBound(sFullName, 1) If sFullName(k, 3) = Dic.Keys()(j - 1) Then m = m + 1 For n = 1 To 7 dFullName(m, n) = sFullName(k, n) Next n End If Next k Worksheets.Add After:=Sheets("Tonghop") ActiveSheet.Range("A3").Resize(18, 7) = dFullName ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2)) k = 0: m = 0: n = 0 Next j End Sub Nhấp chuột vào đây để mở rộng...
Cảm ơn phuyen89, tuy nhiên, sau khi xem file của bác em thấy có các vấn đề sau: - Khi click commandbutton nhiều lần thì sheet cũng bị tách theo từng đó lần. - Khi chỉnh sửa giữ liệu trên các Sheet con thì Sheet "Tonghop" chưa được cập nhật. Upvote 0 phuyen89

phuyen89

Thành viên tích cực
Tham gia 20/11/08 Bài viết 875 Được thích 341 Nghề nghiệp Student
nguyendinhtutw đã viết: Cảm ơn phuyen89, tuy nhiên, sau khi xem file của bác em thấy có các vấn đề sau: - Khi click commandbutton nhiều lần thì sheet cũng bị tách theo từng đó lần. - Khi chỉnh sửa giữ liệu trên các Sheet con thì Sheet "Tonghop" chưa được cập nhật. Nhấp chuột vào đây để mở rộng...
+ Mình tiến hành Xoá Sheet trước khi Tạo ra. PHP: Sao chép. Private Sub Delete_Sheet() Application.DisplayAlerts = True Dim Wks As Worksheet For Each Wks In Worksheets If Wks.Name <> "Tonghop" Then Wks.Delete End If Application.DisplayAlerts = False Next Wks End Sub

File đính kèm

  • Copy of Sample 1.xlsb Copy of Sample 1.xlsb 21.9 KB · Đọc: 44
Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
hpkhuong đã viết: - Click thì phải biết tự lượng sức. Click rồi thì đừng Click nữa??? Tại sao không kiểm soát mình làm những gì? - Không ai làm 2 chiều. 1 là Sheet Tổng Hợp chuẩn -> Tách ra sheet con. 2 là Các sheet con có sẵn (và là chuẩn) -> Chạy code dữ liệu sẽ tổng hợp về sheet Tổng Hợp. Coi chừng làm kiểu nữa vời 2 chiều có ngày ăn "Hành" đó... Ghi chú: tôi chỉ góp ý, chứ không biết làm nha! Nhấp chuột vào đây để mở rộng...
Cảm ơn bác, nhưng em lưu ý là việc tách này chỉ làm 1 lần, để áp dụng cho dữ liệu hiện đã có sẵn trong sheet "tonghop", kể từ sau này thì sẽ không cập nhật dữ liệu mới trực tiếp vào sheet "tong hop" nữa, mà việc này sẽ được thực hiện thông qua việc cập nhật ở các Sheet con Upvote 0 Ba Tê

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia 5/5/09 Bài viết 12,123 Được thích 17,590 Giới tính Nam
nguyendinhtutw đã viết: Cảm ơn bác, nhưng em lưu ý là việc tách này chỉ làm 1 lần, để áp dụng cho dữ liệu hiện đã có sẵn trong sheet "tonghop", kể từ sau này thì sẽ không cập nhật dữ liệu mới trực tiếp vào sheet "tong hop" nữa, mà việc này sẽ được thực hiện thông qua việc cập nhật ở các Sheet con Nhấp chuột vào đây để mở rộng...
1 sheet TONGHOP, muốn tìm người nào thì Auto Filter người đó, nhập thêm dữ liệu hay xóa dòng "mút chỉ", Sort lại 1 phát là "gom". Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam Em có tìm hiểu được trên mạng và làm được bảng như đính kèm, tuy nhiên mới chỉ tách được tiêu đề, chưa tách được nội dung, các bác xem giúp em xem đang bị sai chỗ nào với ạ.

File đính kèm

  • Sample 1.xlsm Sample 1.xlsm 22.7 KB · Đọc: 20
Upvote 0 vanthinh3101

vanthinh3101

Thành viên tích cực
Tham gia 24/1/15 Bài viết 1,129 Được thích 1,494 Giới tính Nam Nghề nghiệp Finance
nguyendinhtutw đã viết: Cảm ơn bác, nhưng em lưu ý là việc tách này chỉ làm 1 lần, để áp dụng cho dữ liệu hiện đã có sẵn trong sheet "tonghop", kể từ sau này thì sẽ không cập nhật dữ liệu mới trực tiếp vào sheet "tong hop" nữa, mà việc này sẽ được thực hiện thông qua việc cập nhật ở các Sheet con Nhấp chuột vào đây để mở rộng...
Tôi thấy cảnh bảo của @hpkhuong không sai đâu, bạn đang làm ngược đấy. Bạn nên dùng sheets Tổng hợp để theo dõi mọi số liệu, sau mỗi lần thay đổi số liệu, bạn cập nhật lại vào các Sheet con là cách hay hơn. Tôi sẽ làm qua các bước sau: - Bước 1: Dùng lệnh Offset để tạo Name động cho vùng dữ liệu của Bảng tổng hợp - Bước 2: Tạo 1 sheet PivotTable để tạo Pivot Table - Bước 3: Dùng code của @kyo để bảng Pivot Table có thể tự động cập nhật khi dữ liệu nguồn thay đổi - Bước 4: Dùng code của @be09 để tách sheets theo Pivot Table Khi dữ liệu ở Sheet Tong hop thay đổi, bạn click lại nút Tách Sheets là các dữ liệu con sẽ thay đổi theo Bạn xem file đính kèm nhé!

File đính kèm

  • Sample 1.xlsm Sample 1.xlsm 34.7 KB · Đọc: 114
Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
hpkhuong đã viết: 1. Chạy code này để tách (chạy 1 lần đầu thôi). Mã: Sao chép. Public Sub Tach_Sheet() Dim Dic As Object, Tmp, I As Long, K As Long, sArr, Rng As Range, Ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next For Each Ws In Worksheets If Ws.Name <> "Tong hop" Then Ws.Delete Next sArr = Range("C3", Range("C3").End(4)).Value Set Rng = Range("A2").CurrentRegion Set Dic = CreateObject("Scripting.Dictionary") For I = 1 To UBound(sArr) If sArr(I, 1) <> Empty Then Tmp = sArr(I, 1) If Not Dic.exists(Tmp) Then Dic.Add Tmp, "" Rng.AutoFilter 3, Tmp Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = Tmp Rng.SpecialCells(12).Copy Sheets(Tmp).Range("A2").PasteSpecial 8 Sheets(Tmp).Range("A2").PasteSpecial xlPasteAll End If End If Next Sheet1.Activate Sheet1.ShowAllData Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 2. Code này copy vào sheet "Tong hop". Cập nhật dữ liệu ở sheet con sẽ tự động chạy về tổng hợp Mã: Sao chép. Private Sub Worksheet_Activate() Dim sArr, dArr(1 To 65000, 1 To 7), I As Long, J As Long, K As Long, Ws As Worksheet Application.ScreenUpdating = False For Each Ws In Worksheets If Ws.Name <> "Tong hop" Then sArr = Ws.Range("A2").CurrentRegion.Value For I = 2 To UBound(sArr) K = K + 1 dArr(K, 1) = K For J = 2 To 7 dArr(K, J) = sArr(I, J) Next Next End If Next If K Then With Sheets("Tong hop") .Range("A2").CurrentRegion.Offset(1).Borders.LineStyle = 0 .Range("A2").CurrentRegion.Offset(1).ClearContents .Range("A3").Resize(K, 7).Value = dArr .Range("A3").Resize(K, 7).Borders.LineStyle = 1 End With End If Application.ScreenUpdating = True End Sub Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác, chúc bác 1 ngày tốt lành :D Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
hpkhuong đã viết: 1. Chạy code này để tách (chạy 1 lần đầu thôi). Mã: Sao chép. Public Sub Tach_Sheet() Dim Dic As Object, Tmp, I As Long, K As Long, sArr, Rng As Range, Ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next For Each Ws In Worksheets If Ws.Name <> "Tong hop" Then Ws.Delete Next sArr = Range("C3", Range("C3").End(4)).Value Set Rng = Range("A2").CurrentRegion Set Dic = CreateObject("Scripting.Dictionary") For I = 1 To UBound(sArr) If sArr(I, 1) <> Empty Then Tmp = sArr(I, 1) If Not Dic.exists(Tmp) Then Dic.Add Tmp, "" Rng.AutoFilter 3, Tmp Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = Tmp Rng.SpecialCells(12).Copy Sheets(Tmp).Range("A2").PasteSpecial 8 Sheets(Tmp).Range("A2").PasteSpecial xlPasteAll End If End If Next Sheet1.Activate Sheet1.ShowAllData Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 2. Code này copy vào sheet "Tong hop". Cập nhật dữ liệu ở sheet con sẽ tự động chạy về tổng hợp Mã: Sao chép. Private Sub Worksheet_Activate() Dim sArr, dArr(1 To 65000, 1 To 7), I As Long, J As Long, K As Long, Ws As Worksheet Application.ScreenUpdating = False For Each Ws In Worksheets If Ws.Name <> "Tong hop" Then sArr = Ws.Range("A2").CurrentRegion.Value For I = 2 To UBound(sArr) K = K + 1 dArr(K, 1) = K For J = 2 To 7 dArr(K, J) = sArr(I, J) Next Next End If Next If K Then With Sheets("Tong hop") .Range("A2").CurrentRegion.Offset(1).Borders.LineStyle = 0 .Range("A2").CurrentRegion.Offset(1).ClearContents .Range("A3").Resize(K, 7).Value = dArr .Range("A3").Resize(K, 7).Borders.LineStyle = 1 End With End If Application.ScreenUpdating = True End Sub Nhấp chuột vào đây để mở rộng...
Dear bác hpkhuong, Theo code của bác thì lúc tách file sẽ xóa toàn bộ các sheet khác, chỉ để lại sheet "tonghop", nhưng file thực tế em đang thực hiện có 1 sheet ( tạm gọi là Sheet A) không thể xóa đi được, việc này em có thể sửa code để lúc tách file sẽ không xóa sheet đó. Nhưng một vấn đề nảy sinh khi tổng hợp dữ liệu từ các sheet con về sheet "tonghop", có thể sửa code của bác như thế nào để không cho dữ liệu từ Sheet A nhảy về sheet "tonghop' được không? Em cảm ơn bác! Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
hpkhuong đã viết: Bạn biết sửa code -> bạn tự xử được mà. Nếu sheet tạm của bạn ít thì bạn có thể xem câu lệnh trong code để loại trừ nó. Trường hợp sheet tạm nhiều thì: ->Vậy bạn phải có 1 danh sách tên những sheet cần tổng hợp về sheet tổng hợp. Và dùng vòng lặp duyệt danh sách này. Nếu thỏa thì lấy về tổng hợp. Nhấp chuột vào đây để mở rộng...
Lúc tách sheet, em có sửa đoạn code như sau: If Ws.Name <> "Tong hop" and Ws.Name <> "SheetA" Then Ws.Delete em đã thử và thấy vẫn tách được sheet và giữ được sheetA không bi xóa. ..... Tuy nhiên, với tư duy tương tự khi sửa code để cho dữ liệu nhảy từ các sheet con về thì file tổng hợp bị lộn xộn rất nhiều: If Ws.Name <> "Tong hop" and Ws.Name <> "SheetA" Then Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
hpkhuong đã viết: Bạn biết sửa code -> bạn tự xử được mà. Nếu sheet tạm của bạn ít thì bạn có thể xem câu lệnh trong code để loại trừ nó. Trường hợp sheet tạm nhiều thì: ->Vậy bạn phải có 1 danh sách tên những sheet cần tổng hợp về sheet tổng hợp. Và dùng vòng lặp duyệt danh sách này. Nếu thỏa thì lấy về tổng hợp. Nhấp chuột vào đây để mở rộng...
Như file đính kèm em đã tách được file theo code của bác, tuy nhiên khi áp dụng code như bên dưới để cho dữ liệu từ sheet con tự tổng hợp về sheet "tonghop" thì không được: Private Sub Worksheet_Activate() Dim sArr, dArr(1 To 65000, 1 To 45), I As Long, J As Long, K As Long, Ws As Worksheet Application.ScreenUpdating = False For Each Ws In Worksheets If Ws.Name <> "TH Hop dong" and Ws.Name <> "Drop" Then sArr = Ws.Range("A3").CurrentRegion.Value For I = 2 To UBound(sArr) K = K + 1 dArr(K, 1) = K For J = 2 To 45 dArr(K, J) = sArr(I, J) Next Next End If Next If K Then With Sheets("TH Hop dong") .Range("A3").CurrentRegion.Offset(1).Borders.LineStyle = 0 .Range("A3").CurrentRegion.Offset(1).ClearContents .Range("A4").Resize(K, 45).Value = dArr .Range("A4").Resize(K, 45).Borders.LineStyle = 1 End With End If Application.ScreenUpdating = True End Sub

File đính kèm

  • DEV333.xlsm DEV333.xlsm 216.5 KB · Đọc: 47
Upvote 0 nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia 17/4/17 Bài viết 73 Được thích 3 Giới tính Nam
hpkhuong đã viết: Mã: Sao chép. Public Sub Tach_Sheet() Dim Dic As Object, Tmp, I As Long, K As Long, sArr, Rng As Range, Ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next For Each Ws In Worksheets If Ws.Name <> "TH Hop dong" And Ws.Name <> "Drop" Then Ws.Delete Next Set Rng = Sheet1.UsedRange sArr = Rng.Value Set Dic = CreateObject("Scripting.Dictionary") For I = 4 To UBound(sArr) If sArr(I, 4) <> Empty Then Tmp = sArr(I, 4) If Not Dic.exists(Tmp) Then Dic.Add Tmp, "" Rng.Offset(3).AutoFilter 4, Tmp Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = Tmp Rng.SpecialCells(12).Copy Sheets(Tmp).Range("A1").PasteSpecial 8 Sheets(Tmp).Range("A1").PasteSpecial xlPasteAll End If End If Next Sheet1.Activate Sheet1.ShowAllData Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Mã: Sao chép. Private Sub Worksheet_Activate() Dim sArr, dArr(1 To 65000, 1 To 45), I As Long, J As Long, K As Long, Ws As Worksheet Application.ScreenUpdating = False For Each Ws In Worksheets If Ws.Name <> "TH Hop dong" And Ws.Name <> "Drop" Then sArr = Ws.UsedRange.Value For I = 4 To UBound(sArr) If Len(sArr(I, 4)) Then K = K + 1 For J = 1 To 45 dArr(K, J) = sArr(I, J) Next End If Next End If Next If K Then With Sheets("TH Hop dong") .UsedRange.Offset(3).Borders.LineStyle = 0 .UsedRange.Offset(3).ClearContents .Range("A4").Resize(K, 45).Value = dArr .Range("A4").Resize(K, 45).Borders.LineStyle = 1 End With End If Application.ScreenUpdating = True End Sub Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác :D Upvote 0 Lê Duy Thương

Lê Duy Thương

Cạo lấy gì gội (Dịch quá không gội được)
Tham gia 14/10/09 Bài viết 3,116 Được thích 4,854
phuyen89 đã viết: + Mình tiến hành Xoá Sheet trước khi Tạo ra. PHP: Sao chép. Private Sub Delete_Sheet() Application.DisplayAlerts = True Dim Wks As Worksheet For Each Wks In Worksheets If Wks.Name <> "Tonghop" Then Wks.Delete End If Application.DisplayAlerts = False Next Wks End Sub Nhấp chuột vào đây để mở rộng...
Bổ sung. Có thể viết thêm code kiểm tra sheet tồn tại chưa. Nếu sheet đã tồn tại rồi thì phải làm gì.... Upvote 0 Gakafu

Gakafu

Thành viên mới
Tham gia 16/11/20 Bài viết 4 Được thích 2
phuyen89 đã viết: Range("C60000").End(xlUp)).Resize(, 5).Copy Sheets("Tong hop").Range("C60000").End(xlUp).Offset(1, -2).PasteSpecial xlPasteValues End If Next Wks End Sub Nhấp chuột vào đây để mở rộng...
Anh ơi , hỗ trợ giúp em được không ạ ? Upvote 0 be_09

be_09

Biên Hòa, Đồng Nai
Tham gia 9/4/11 Bài viết 9,972 Được thích 9,884 Nghề nghiệp Công chức
Gakafu đã viết: Anh ơi , hỗ trợ giúp em được không ạ ? Nhấp chuột vào đây để mở rộng...
Góp ý cho bạn: 1/ Bạn đã đăng bài trong chủ đề tách sheet thì bạn nên đính kèm File và tiếp tục hỏi ở đây chứ không nên mở Topic mới vì có thể sẽ vi phạm nội quy. 2/ Cách hỏi của bạn trống không thế này "hỗ trợ giúp em được không ạ ?" là thiếu tôn trọng với các tành viên trên diễn đàn. 3/ Khi hỏi thì nên cụ thể việc tách sheet của bạn thì dựa vào cột nào? Của sheet nào? Upvote 0 test1986

test1986

Thành viên chính thức
Tham gia 19/10/22 Bài viết 55 Được thích 11
vanthinh3101 đã viết: Tôi thấy cảnh bảo của @hpkhuong không sai đâu, bạn đang làm ngược đấy. Bạn nên dùng sheets Tổng hợp để theo dõi mọi số liệu, sau mỗi lần thay đổi số liệu, bạn cập nhật lại vào các Sheet con là cách hay hơn. Tôi sẽ làm qua các bước sau: - Bước 1: Dùng lệnh Offset để tạo Name động cho vùng dữ liệu của Bảng tổng hợp - Bước 2: Tạo 1 sheet PivotTable để tạo Pivot Table - Bước 3: Dùng code của @kyo để bảng Pivot Table có thể tự động cập nhật khi dữ liệu nguồn thay đổi - Bước 4: Dùng code của @be09 để tách sheets theo Pivot Table Khi dữ liệu ở Sheet Tong hop thay đổi, bạn click lại nút Tách Sheets là các dữ liệu con sẽ thay đổi theo Bạn xem file đính kèm nhé! Nhấp chuột vào đây để mở rộng...
Em đang gặp phải một vấn đề kỳ lạ khi chạy thử file đính kèm ở bài viết #14. Chạy file thì không báo lỗi nhưng có lúc thì sheet được tách ra sẽ có tên là "Nguyễn Văn A", "Nguyễn Văn B", "Nguyễn Văn C" nhưng có lúc sheet tách ra lại có tên là "Detail1", "Detail2", "Detail3". Tên sheet tách ra sẽ được đổi tên theo một trong hai kiểu trên. PHP: Sao chép. Sub DoiTen_SheetTach() Dim sht As Worksheet For Each sht In ThisWorkbook.Worksheets On Error Resume Next If sht.Name <> "PivotTable" And sht.Name <> "Tong hop" And sht.Name <> "PivotTable" Then sht.Name = sht.Range("C2") sht.Activate Cells.EntireColumn.AutoFit Sheets("PivotTable").Select End If Next sht End Sub Em đang nguyên cứu để tự động đổi tên sheet từ đoạn code của bác @vanthinh3101 để áp dụng vào công việc nhưng kết quả chạy thử làm em lú lẫn luôn. Mong mọi người xem bài có thể giúp em tìm ra nguyên nhân kết quả đổi tên không thống nhất như vậy ạ. Em xin cảm ơn. Upvote 0 H

hvnhpro

Thành viên hoạt động
Tham gia 3/3/11 Bài viết 163 Được thích 93 Giới tính Nam
test1986 đã viết: Em đang gặp phải một vấn đề kỳ lạ khi chạy thử file đính kèm ở bài viết #14. Chạy file thì không báo lỗi nhưng có lúc thì sheet được tách ra sẽ có tên là "Nguyễn Văn A", "Nguyễn Văn B", "Nguyễn Văn C" nhưng có lúc sheet tách ra lại có tên là "Detail1", "Detail2", "Detail3". Tên sheet tách ra sẽ được đổi tên theo một trong hai kiểu trên. PHP: Sao chép. Sub DoiTen_SheetTach() Dim sht As Worksheet For Each sht In ThisWorkbook.Worksheets On Error Resume Next If sht.Name <> "PivotTable" And sht.Name <> "Tong hop" And sht.Name <> "PivotTable" Then sht.Name = sht.Range("C2") sht.Activate Cells.EntireColumn.AutoFit Sheets("PivotTable").Select End If Next sht End Sub Em đang nguyên cứu để tự động đổi tên sheet từ đoạn code của bác @vanthinh3101 để áp dụng vào công việc nhưng kết quả chạy thử làm em lú lẫn luôn. Mong mọi người xem bài có thể giúp em tìm ra nguyên nhân kết quả đổi tên không thống nhất như vậy ạ. Em xin cảm ơn. Nhấp chuột vào đây để mở rộng...
Vụ đổi tên sheet thì bạn nên hiểu đoạn này "sht.Name = sht.Range("C2")" Tên sheet sẽ được đặt theo Range("C2") tại sheet cần đổi. Upvote 0 test1986

test1986

Thành viên chính thức
Tham gia 19/10/22 Bài viết 55 Được thích 11
hvnhpro đã viết: Vụ đổi tên sheet thì bạn nên hiểu đoạn này "sht.Name = sht.Range("C2")" Tên sheet sẽ được đặt theo Range("C2") tại sheet cần đổi. Nhấp chuột vào đây để mở rộng...
Dạ đúng rồi ạ, nên nếu đúng theo lý thuyết thì sẽ phải đổi tên sheet thống nhất là "Nguyễn Văn A", "Nguyễn Văn B", Nguyễn Văn C" là kết quả đúng. Nhưng không hiểu vì sao lại có trường hợp đổi tên thứ 2 là sheet thay vì đổi tên như trên thì lại đổi tên thành "Detail1", "Detail2", "detail3" mà trong table hàng cột đều không có giá trị"Detail1", "Detail2", "Detail3" để mà gán tên cho sheet, giống như là trên trời rơi xuống vậy á anh. Upvote 0 H

hvnhpro

Thành viên hoạt động
Tham gia 3/3/11 Bài viết 163 Được thích 93 Giới tính Nam
test1986 đã viết: Dạ đúng rồi ạ, nên nếu đúng theo lý thuyết thì sẽ phải đổi tên sheet thống nhất là "Nguyễn Văn A", "Nguyễn Văn B", Nguyễn Văn C" là kết quả đúng. Nhưng không hiểu vì sao lại có trường hợp đổi tên thứ 2 là sheet thay vì đổi tên như trên thì lại đổi tên thành "Detail1", "Detail2", "detail3" mà trong table hàng cột đều không có giá trị"Detail1", "Detail2", "Detail3" để mà gán tên cho sheet, giống như là trên trời rơi xuống vậy á anh. Nhấp chuột vào đây để mở rộng...
thế bạn phải chạy debug mới biết được code lấy dữ liệu như thế nào. Không có file mà chỉ nhìn code, mình đoán mò được thế thôi. Upvote 0 test1986

test1986

Thành viên chính thức
Tham gia 19/10/22 Bài viết 55 Được thích 11
hvnhpro đã viết: thế bạn phải chạy debug mới biết được code lấy dữ liệu như thế nào. Không có file mà chỉ nhìn code, mình đoán mò được thế thôi. Nhấp chuột vào đây để mở rộng...
dạ file đính kèm ở bài viết #14 dó anh. Em chạy thử thì gặp lỗi như vậy ạ. Upvote 0 Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

mrjun80 Xin giúp hàm excel để tìm 1 số trong số có 2 chữ số (1 người xem)
  • mrjun80
  • Hôm qua, lúc 23:43
  • Hàm và công thức Excel
Trả lời 4 Đọc 60 Hôm nay lúc 08:38 Gà Con yêu VBA Gà Con yêu VBA ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (4 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
  • ongke0711
  • 6/10/24
  • Lập Trình với Excel
5 6 7 Trả lời 611 Đọc 90K Hôm nay lúc 01:02 giaphuc02122018 G HeSanbi
  • Đã giải quyết
FitRowXL v1.0 - Giãn dòng tự động và bổ trợ in ấn Excel (*01/2026 mới) (1 người xem)
    • Thích
    • Yêu thích
  • HeSanbi
  • 18/4/21
  • Lập Trình với Excel
Trả lời 62 Đọc 29K Hôm qua, lúc 23:57 HeSanbi HeSanbi N Vấn đề về hiệu năng khi thực hiện ghép chuỗi trong VBA với tần suất lớn (1 người xem)
    • Thích
    • Cảm ơn
  • nguyendang95
  • 23/1/26
  • Excel và các ngôn ngữ lập trình khác
Trả lời 36 Đọc 879 Hôm qua, lúc 21:11 ptm0412 ptm0412 SA_DQ Copilot bình luận các ván cờ vua từng ngày. (2 người xem)
    • Thích
  • SA_DQ
  • 3/11/25
  • Chia sẻ
Trả lời 52 Đọc 2K Hôm qua, lúc 18:02 SA_DQ SA_DQ ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
  • ongke0711
  • 24/7/25
  • Lập Trình với Excel
Trả lời 16 Đọc 2K Hôm qua, lúc 17:46 tuyethao T phuongnam366377 VNFastSearch – DLL tìm kiếm tiếng Việt tốc độ cao cho Excel VBA
  • phuongnam366377
  • Hôm qua, lúc 14:41
  • Excel và các ngôn ngữ lập trình khác
Trả lời 0 Đọc 61 Hôm qua, lúc 14:41 phuongnam366377 phuongnam366377 V Một con add-in vibe coding (1 người xem)
    • Thích
  • vietdang170
  • Thứ tư lúc 12:55
  • Các Add-ins cho excel
Trả lời 10 Đọc 354 Hôm qua, lúc 13:52 Maika8008 Maika8008 N
  • Question Question
Tạo khung viền ô theo số trong ô
    • Thích
  • Nguyễn Xuân Sơn
  • Thứ năm lúc 13:44
  • Lập Trình với Excel
Trả lời 9 Đọc 160 Hôm qua, lúc 12:25 Mr.hieudoanxd Mr.hieudoanxd J Đừng chỉ "Cập nhật" dữ liệu. Hãy "Xếp chồng" chúng lên.
    • Thích
  • jack nt
  • Thứ năm lúc 17:19
  • Excel và các ngôn ngữ lập trình khác
Trả lời 5 Đọc 222 Hôm qua, lúc 10:27 ptm0412 ptm0412 T gửi email đến nhân viên công ty
  • tuantv9
  • Thứ hai lúc 23:18
  • Excel và các ngôn ngữ lập trình khác
Trả lời 2 Đọc 216 Thứ sáu lúc 09:28 nguyendang95 N H
  • Question Question
Code trích lọc mặt hàng theo thuế suất GTGT
  • hoanglocphat
  • Thứ năm lúc 10:36
  • Lập Trình với Excel
Trả lời 4 Đọc 174 Thứ sáu lúc 09:25 Maika8008 Maika8008 Nguyenkhang2404 Hỏi cách tổng hợp dữ liệu (1 người xem)
  • Nguyenkhang2404
  • Thứ ba lúc 20:24
  • Hàm và công thức Excel
Trả lời 12 Đọc 288 Thứ năm lúc 14:22 ptm0412 ptm0412 giaiphap Add-Ins cho Excel 2007 -2016 32bit và 64bit
    • Thích
    • Yêu thích
    • Ngạc nhiên
  • giaiphap
  • 8/8/15
  • Các Add-ins cho excel
4 5 6 Trả lời 517 Đọc 225K Thứ năm lúc 09:51 Gà Công Nghệ Gà Công Nghệ Nguyễn Duy Tuân
  • Dán lên cao
Hướng dẫn lập trình VBA với Google Sheets và Excel Online | Add-in A-Tools v10
    • Thích
  • Nguyễn Duy Tuân
  • 28/11/24
  • BLUESOFTS: A-Excel, A-Tools
Trả lời 12 Đọc 2K Thứ tư lúc 23:38 Nguyễn Duy Tuân Nguyễn Duy Tuân Q Tính Tổng Có Điều Kiện Từ Nhiều Sheet
  • quydangktk
  • 20/1/11
  • Hàm và công thức Excel
Trả lời 32 Đọc 34K Thứ tư lúc 17:46 87kilua 87kilua phuongnam366377 StringCore – Thư viện COM StringBuffer hiệu năng cao (Free Binary)
  • phuongnam366377
  • Thứ hai lúc 15:46
  • Excel và các ngôn ngữ lập trình khác
Trả lời 2 Đọc 234 Thứ ba lúc 16:15 phuongnam366377 phuongnam366377 HeSanbi TaxCode v4.29 - Tra cứu mã số thuế từ tổng cục thuế, masothue và thuvienphapluat
    • Thích
    • Yêu thích
  • HeSanbi
  • 27/11/25
  • Các Add-ins cho excel
Trả lời 18 Đọc 2K Thứ ba lúc 09:42 HeSanbi HeSanbi D File sau khi lưu bị nhảy cột
  • Dé Noir
  • 23/1/26
  • Giải thích, gỡ rối, xử lý lỗi công thức
Trả lời 5 Đọc 231 25/1/26 Dé Noir D HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động (phiên bản 2026)
    • Thích
    • Yêu thích
  • HeSanbi
  • 5/3/21
  • Lập Trình với Excel
Trả lời 84 Đọc 18K 24/1/26 HeSanbi HeSanbi Xem thêm… Chia sẻ: Facebook X Bluesky LinkedIn Reddit Pinterest Tumblr WhatsApp Email Chia sẻ Link

Thành viên có số lượng bài viết cao nhất tháng

  • Phuocam 1
  • Gà Con yêu VBA 1

Thành viên có điểm tương tác cao nhất tháng

  • Phuocam 1
  • Gà Con yêu VBA 1

Thời gian đếm ngược.

000 Ngày 00 Giờ 00 phút 00 giây Thân mời tham dự sự kiện sinh nhật GPE 2025
  • Trang chủ
  • Diễn đàn
  • Lập Trình với Excel
  • Website này sử dụng cookies. Tiếp tục sử dụng trang này, đồng nghĩa với việc bạn chấp nhận website sử dụng cookies. Chấp nhận Tìm hiểu thêm.…
Back Top Bottom

Từ khóa » Tách Sheet Theo điều Kiện