TÁCH SHEET TỔNG HỢP GIỮ ĐỊNH DẠNG

[ttsuong]

Chào anh/chị
Em muốn tách file này theo cột E Bộ phận nhưng vẫn giữ nguyên định dạng từ sheet tổng. Cuối mỗi sheet con đã tách vẫn có dòng người lập, xác nhận, phê duyệt như sheet tổng.
Nhờ anh/chị hỗ trợ ạ.

 

[Quang_Hải]

Chào anh/chị
Em muốn tách file này theo cột E Bộ phận nhưng vẫn giữ nguyên định dạng từ sheet tổng. Cuối mỗi sheet con đã tách vẫn có dòng người lập, xác nhận, phê duyệt như sheet tổng.
Nhờ anh/chị hỗ trợ ạ.

Thử đoạn code này.

Sub Tach_Sheet()
Dim Dic As Object, sArr(), i As Long, Tmp As String, MyRange As Range, Item As Variant
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
    sArr = .Range("A1").CurrentRegion.Value
    Set MyRange = .Range("A1").CurrentRegion
End With
For i = 2 To UBound(sArr) - 2
    Tmp = sArr(i, 5)
    If Tmp <> Empty Then Dic(Tmp) = Empty
Next
For Each Item In Dic.keys
    MyRange.AutoFilter 5, Item
    MyRange.SpecialCells(xlCellTypeVisible).Copy
    With Sheets.Add
         MyRange.SpecialCells(xlCellTypeVisible).Copy .Range("A1")
         .Name = Item
    End With
    MyRange.AutoFilter
Next
End Sub

 

[VetMini]

Loại bài này người ta copy sheet > Filter > Xóa phần ẩn, Hoặc Advanced Filter.
Chứ VBA thì lười biếng quá.