Chia file tổng thành nhiều sheet trong excel

Liên hệ QC

nguyendinhvinh0410

Thành viên mới
Tham gia
8/5/13
Bài viết
25
Được thích
0
Mình có một sheet tên là "tonghop" mình muốn tách sheet "tonghop"
Ý muốn hỏi 1: tách thành nhiều sheet con theo điều kiện (dữ liệu của một tỉnh chia thành dữ liệu con là theo huyện) có kèm theo file đính kèm.
Ý muốn hỏi 2: các sheet con của từng huyện kết nối với dữ liệu sheet "tonghop" nghĩa là nếu trong sheet "tonghop" thay đổi thì sheet con thay đổi theo. EM cảm ơn trước ạ!
Em hỏi có hai ý. các bạn giúp được ý nào thì xin chỉ giáo ạ!
 

File đính kèm

Mình có một sheet tên là "tonghop" mình muốn tách sheet "tonghop"
Ý muốn hỏi 1: tách thành nhiều sheet con theo điều kiện (dữ liệu của một tỉnh chia thành dữ liệu con là theo huyện) có kèm theo file đính kèm.
Ý muốn hỏi 2: các sheet con của từng huyện kết nối với dữ liệu sheet "tonghop" nghĩa là nếu trong sheet "tonghop" thay đổi thì sheet con thay đổi theo. EM cảm ơn trước ạ!
Em hỏi có hai ý. các bạn giúp được ý nào thì xin chỉ giáo ạ!
Rất dị ứng với những file đặt tên có dấu tiếng Việt. Mở lâu chết đi được!!
 
Không chỉ chạy ra một huyên đầu tiên mong giúp đỡ để chạy hết các huyện còn lại
 
Máy bạn phải được Enable Macro trên Excel

Alt+F11 -> cửa sổ VBE mở ra. Click phải lên vùng phía trên bên trái (Vùng VBAProject) => Insert Module. Module1 được chèn vào
Click vào module1 này, cửa sổ bên Phải mở ra. Copy paste code trên vào.
Quay trở lại excel. Alt+F8 -> RUN cái sub GPE ở trên. Xong

Cách enable Macro: http://www.giaiphapexcel.com/forum/...ẫn-Enable-Macros-trong-Excel-(2003-2007-2010)
Download file #2 về mà xem cách Enable Macro
em đã làm được rồi. nhưng khi áp dụng cho file excel khác không chia theo yêu cầu được. mong a hướng dẫn cách tùy chỉnh code để e vận dụng được nhiều ạ
 
Mã:
Option Explicit
Public Sub GPE()
Dim I, Arr, Dic As Object, Tem, Item As String, lr&
Dim Wb As Object, Rng As Range, Ws As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'For Each Ws In Worksheets
 '   If Ws.Name <> "tonghop" Then Ws.Delete
'Next Ws
Set Wb = Sheet3
With Wb
lr = .[F65000].End(3).Row
Set Rng = .Range("A1:P" & lr)
Set Dic = CreateObject("Scripting.Dictionary")
    Arr = .Range(.[F2], .[F65000].End(3)).Value
    For I = 1 To UBound(Arr)
        Tem = Arr(I, 1)
        If Tem <> Empty And Not Dic.exists(Tem) Then
            Dic.Add Tem, ""
            Item = Tem
            Rng.AutoFilter 6, Item
            .Range(.[A1], Rng).SpecialCells(12).Copy
            Sheets.Add After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Item
            Sheets(Item).[A1].PasteSpecial xlPasteValues
            Sheets(Item).[A1].PasteSpecial xlPasteFormats
         End If
    Next I
    .Activate
    .AutoFilterMode = False
End With
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
em cảm ơn anh em đã làm được. anh cho em hỏi "Rng.AutoFilter 6, Item" cái này phải là cột chứa điều kiện không ạ. ví dụ với file dữ liệu đó em muốn mở rộng ra nữa (không dừng tới cột P mà tới cột V hoặc nhiều hơn nữa) thì code của anh có dùng được không ạ!
 
dạ giờ em muốn mở rộng cột ra không dừng lại ở cột P nữa thì sữa chổ nào của đoạn code ạ!
 
Web KT

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

Back
Top Bottom