nhờ sửa code tách sheet trong excel (1 người xem)

[toannm4]

xin chào các bác
em có 1 file này nhờ các bác sửa code ạ, file này e cũng lấy trên đây cần sửa chút theo y/c
hiện tại file này có thể tách dữ liệu lưu ra các sheet riêng theo cột B tuy nhiên khi tách xong thì các sheet được tách không format theo định dạng chung được, em nhờ các bác sửa code để các sheet được tách theo format chung của sheet "TEMP" ạ.
ngoài ra còn chỗ lưu các sheet thành file excel riêng em phải vào alt + F11 để chạy thủ công, nhờ các bác tạo thêm 1 button "sava file" ở sheet "Data" ạ, cái request này ko cần cũng được ạ
em gửi file nhờ các bác sửa, lần đầu post bài , chân thành cám ơn các bác

 

[vanthinh3101]

xin chào các bác
em có 1 file này nhờ các bác sửa code ạ, file này e cũng lấy trên đây cần sửa chút theo y/c
hiện tại file này có thể tách dữ liệu lưu ra các sheet riêng theo cột B tuy nhiên khi tách xong thì các sheet được tách không format theo định dạng chung được, em nhờ các bác sửa code để các sheet được tách theo format chung của sheet "TEMP" ạ.
ngoài ra còn chỗ lưu các sheet thành file excel riêng em phải vào alt + F11 để chạy thủ công, nhờ các bác tạo thêm 1 button "sava file" ở sheet "Data" ạ, cái request này ko cần cũng được ạ
em gửi file nhờ các bác sửa, lần đầu post bài , chân thành cám ơn các bác

Mình có sửa lại file của bạn 1 chút.
Thêm 1 sheet Criteria để làm dữ liệu lọc, từ sau bạn chỉ cần đưa dữ liệu lọc vào cột A của sheet Criteria
Mình đã viết lại code Tach_nhom cho bạn, sửa lại code xóa sheets vừa thêm, thêm 1 button để save

 

[be_09]

Thay sub này.
Sub XoaSheetVuaThem()

Thành như thế này, để muốn chừa lại sheet nào nữa thì copy tên gán vào cho dễ mà khỏi cần sửa code.

Sub XoaSheetVuaThem()
Application.DisplayAlerts = False
Dim ChuaSheets, TimSh, XoaSheets
ChuaSheets = Array("DATA", "Criteria", "", "")
For Each TimSh In Worksheets
   XoaSheets = Filter(ChuaSheets, TimSh.Name, 1)
   If UBound(XoaSheets) <> 0 Then
     TimSh.Visible = True
     TimSh.Delete
   End If
Next
Application.DisplayAlerts = True

End Sub

Ví dụ: Thêm vô như vầy.

ChuaSheets = Array("DATA", "Criteria", "TRANG_CHU", "DATA_LIST")

 

[vanthinh3101]

Thay sub này.
Sub XoaSheetVuaThem()

Thành như thế này, để muốn chừa lại sheet nào nữa thì copy tên gán vào cho dễ mà khỏi cần sửa code.

Sub XoaSheetVuaThem()
Application.DisplayAlerts = False
Dim ChuaSheets, TimSh, XoaSheets
ChuaSheets = Array("DATA", "Criteria", "", "")
For Each TimSh In Worksheets
   XoaSheets = Filter(ChuaSheets, TimSh.Name, 1)
   If UBound(XoaSheets) <> 0 Then
     TimSh.Visible = True
     TimSh.Delete
   End If
Next
Application.DisplayAlerts = True

End Sub

Ví dụ: Thêm vô như vầy.

ChuaSheets = Array("DATA", "Criteria", "TRANG_CHU", "DATA_LIST")

Em muốn nhờ bác be09 tư vấn cho cách viết code ở trường hợp lọc dữ liệu và tách sheet.
Nếu như không thêm Sheet Criteria, lấy dữ liệu lọc luôn ở cột Mã đơn vị thì làm thế nào để code hoạt động chính xác khi có các dữ liệu trùng nhau. Ví dụ như có 2 dòng là QLDA, khi chạy For ... Next thì sẽ bị lặp lại 2 lần.

 

[be_09]

Em muốn nhờ bác be09 tư vấn cho cách viết code ở trường hợp lọc dữ liệu và tách sheet.
Nếu như không thêm Sheet Criteria, lấy dữ liệu lọc luôn ở cột Mã đơn vị thì làm thế nào để code hoạt động chính xác khi có các dữ liệu trùng nhau. Ví dụ như có 2 dòng là QLDA, khi chạy For ... Next thì sẽ bị lặp lại 2 lần.

Tôi thấy bạn dùng PivotTable, thì cũng có thể dùng PivotTable để tách sheet tốc độ sẽ nhanh hơn mà đỡ giựt màn hình.

 

[vanthinh3101]

Tôi thấy bạn dùng PivotTable, thì cũng có thể dùng PivotTable để tách sheet tốc độ sẽ nhanh hơn mà đỡ giựt màn hình.

Xin lỗi bác, em chưa biết dùng Pivot table để tách sheet bao giờ, bác cho thể cho em ví dụ để em học hỏi thêm được không ah?

 

[be_09]

Xin lỗi bác, em chưa biết dùng Pivot table để tách sheet bao giờ, bác cho thể cho em ví dụ để em học hỏi thêm được không ah?

Xem thử File:

Vào sheet PivotTable và nhấn nút để xem kết quả, còn cách dùng code để tạo PivotTable trong File bạn đã có (thì tùy nghi ứng biến).

 

[vanthinh3101]

Xem thử File:

Vào sheet PivotTable và nhấn nút để xem kết quả, còn cách dùng code để tạo PivotTable trong File bạn đã có (thì tùy nghi ứng biến).

Em cám ơn bác đã chỉ bảo

 

[hang.nga]

em có code tách file có 4 sheet thành các file khác vẫn giữ nguyên các sheet như sau, em muốn sửa code để tách file có 18 sheet nhưng sửa không được. Các bác sửa giúp em với ạ (em gửi file cho các bác dễ hình dung)

Sub TachCN()


Workbooks("CHAY LOC VN.xlsm").Activate
c = Range("b1048576").End(xlUp).Row
ReDim arr(c - 2)
For i = 2 To c

If Range("B" & i).Value <> "" Then
arr(i - 2) = Range("B" & i).Value
End If
Next i


For k = 0 To UBound(arr)
CN = arr(k)

With Workbooks.Add
.Sheets.Add
.SaveAs ThisWorkbook.Path & "\" & CN & ".xlsx"
End With

For j = 1 To 4

Workbooks("Phan_tich_NV.xlsx").Sheets(j).Activate

dongcuoi = Range("a1048576").End(xlUp).Row

Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter

Workbooks("Phan_tich_NV.xlsx").Sheets(j).Activate
Range("A1").Select
ActiveSheet.Range("$A$1:$K$" & dongcuoi).AutoFilter Field:=11, Criteria1:=CN
dongcuoi4 = Range("b1048576").End(xlUp).Row
Range("A1:K" & dongcuoi4 + 2).Copy

Workbooks(CN & ".xlsx").Sheets(j).Activate
Range("A1").Select
Range("A1").PasteSpecial xlPasteValues
Workbooks(CN & ".xlsx").Sheets(j).Name = Workbooks("Phan_tich_NV.xlsx").Sheets(j).Name

Workbooks("Phan_tich_NV.xlsx").Sheets(j).Activate
Range("A1").Select
ActiveSheet.Range("$A$1:$H$" & dongcuoi).AutoFilter Field:=1
Next
Workbooks(CN & ".xlsx").Close True

Next
End Sub

Em cảm ơn các bác nhiều