Tổng hợp nhiều sheet thành 1 sheet

Liên hệ QC

hoangexcell

Thành viên tiêu biểu
Tham gia
8/1/08
Bài viết
459
Được thích
132
Donate (Momo)
Donate
Giới tính
Nam
Tôi có nhiều sheet có chung tiêu đề khác nội dung và muốn tổng hợp lại thành 1 sheet thì làm thế nào? Xin xem file đính kèm sẽ rõ hơn. Xin Cám ơn
 

File đính kèm

  • Tonghop_nhieu_sheet.xls
    18.5 KB · Đọc: 383
Tôi có nhiều sheet có chung tiêu đề khác nội dung và muốn tổng hợp lại thành 1 sheet thì làm thế nào? Xin xem file đính kèm sẽ rõ hơn. Xin Cám ơn
Bạn xài tạm code này cho sheet Tonghop nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim i As Byte
    Application.ScreenUpdating = False
    Me.Move before:=Sheets(1)
    [3:10000].Delete
    For i = 2 To Sheets.Count
        Sheets(i).[3:1000].Copy [A65536].End(xlUp).Offset(1)
    Next
    Application.ScreenUpdating = True
End Sub
Mỗi lần chọn sheet Tonghop thì dữ liệu sẽ được "Refresh" lại.
Điều kiện: Tất cả các sheet đều có cấu trúc giống sheet Tonghop.
 

File đính kèm

  • Tonghop_nhieu_sheet.rar
    9.5 KB · Đọc: 904
XIn cám ơn rất nhiều. Chưa dùng thiệt nhưng xem qua cảm thấy ổn rồi đó.@$@!^%
 
Phúc ới, khi bỏ vào dữ liệu thật thì có sheet nó không copy hết data là vì sao nhỉ!?
 
Phúc ơi, có một nhu cầu mới về cái này là:

1. Chỉ tổng hợp 1 số sheet nhất định chứ không copy hết có được không?
2. Khi copy thì chỉ copy giá trị, không copy công thức

Xin cám ơn nhiều
 
Phúc ơi, có một nhu cầu mới về cái này là:

1. Chỉ tổng hợp 1 số sheet nhất định chứ không copy hết có được không?
2. Khi copy thì chỉ copy giá trị, không copy công thức

Xin cám ơn nhiều
Bạn sử dụng code này thay cho code trên nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim Ws As Worksheet
    Application.ScreenUpdating = False
    [3:65536].Delete
    For Each Ws In ThisWorkbook.Worksheets
        If InStr(".A.C.", "." & Ws.Name & ".") > 0 Then
            With Ws.Range("A3:P" & Ws.[A65536].End(xlUp).Row)
                [A65536].End(xlUp).Offset(1).Resize(.Rows.Count, 16).Value = .Value
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Để thay đổi danh sách các sheet cần tổng hợp, bạn thay đổi chuỗi ".A.C." nhé (các tên sheet được đặt giữa 2 dấu chấm để phòng trường hợp có nhiều tên sheet gần giống nhau kiểu như Sheet1, Sheet10, Sheet11,...)
 
Bác Phúc ơi!
Bác giúp em cái code này với.Em có 3 Sheet giống nhau cả về tiêu đề bác giúp em tổng hợp cả 3 với nhé
 
Bạn xài tạm code này cho sheet Tonghop nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim i As Byte
    Application.ScreenUpdating = False
    Me.Move before:=Sheets(1)
    [3:10000].Delete
    For i = 2 To Sheets.Count
        Sheets(i).[3:1000].Copy [A65536].End(xlUp).Offset(1)
    Next
    Application.ScreenUpdating = True
End Sub
Mỗi lần chọn sheet Tonghop thì dữ liệu sẽ được "Refresh" lại.
Điều kiện: Tất cả các sheet đều có cấu trúc giống sheet Tonghop.

Với code này thì mình chỉ tổng hợp loại trừ 1 sheet nào đó
VD: Tổng hợp tất cả các sheet Nhưng loại trừ 1 sheet Lương chẳng hạn
Vậy thì phải làm sao vậy anh
 
Với code này thì mình chỉ tổng hợp loại trừ 1 sheet nào đó
VD: Tổng hợp tất cả các sheet Nhưng loại trừ 1 sheet Lương chẳng hạn
Vậy thì phải làm sao vậy anh
Câu trả lời nằm tại bài #7 đó bạn.
Có thể sửa điều kiện
PHP:
If InStr(".A.C.", "." & Ws.Name & ".") > 0 Then
bởi điều kiện
PHP:
If Ws.Name <> "Luong" Then
 
Câu trả lời nằm tại bài #7 đó bạn.
Có thể sửa điều kiện
PHP:
If InStr(".A.C.", "." & Ws.Name & ".") > 0 Then
bởi điều kiện
PHP:
If Ws.Name <> "Luong" Then
Ok, nhưng mình còn 1 thắc măc nưa anh Phúc ơi.
Nhưng mình muốn Sheets Tong hop nó sẽ thể hiện theo định dang của sheest chi tiết, Có dấu phân cách ( lần gach liền nhau, hay là màu khác ) khi kết thúc số liệu cúa sheets 1 và sheet 2, ...
 
Ok, nhưng mình còn 1 thắc măc nưa anh Phúc ơi.
Nhưng mình muốn Sheets Tong hop nó sẽ thể hiện theo định dang của sheest chi tiết, Có dấu phân cách ( lần gach liền nhau, hay là màu khác ) khi kết thúc số liệu cúa sheets 1 và sheet 2, ...
Bạn thử nghiệm 2 dạng câu lệnh: Nguồn.Copy ĐíchĐích.Value=Nguồn.Value, bạn sẽ thấy: Với câu lệnh 1 thì ở Nguồn có định dạng ra sao thì Đích sẽ có định dạng giống như vậy, còn câu lệnh thứ 2 chỉ copy giá trị từ Nguồn tới Đích mà không làm thay đổi định dạng của Đích. Bạn chỉ cần vận dụng linh hoạt 2 dạng câu lệnh trên là được.
 
Bạn thử nghiệm 2 dạng câu lệnh: Nguồn.Copy ĐíchĐích.Value=Nguồn.Value, bạn sẽ thấy: Với câu lệnh 1 thì ở Nguồn có định dạng ra sao thì Đích sẽ có định dạng giống như vậy, còn câu lệnh thứ 2 chỉ copy giá trị từ Nguồn tới Đích mà không làm thay đổi định dạng của Đích. Bạn chỉ cần vận dụng linh hoạt 2 dạng câu lệnh trên là được.



Mã:
Private Sub Worksheet_Activate()
    Dim Ws As Worksheet
    Dim i As Byte
    Application.ScreenUpdating = False
    [3:65536].Delete
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> "Luong" Then
[COLOR=#ff0000]            For i = 2 To Sheets.Count[/COLOR]
[COLOR=#ff0000]                Sheets(i).[3:1000].Copy [A65536].End(xlUp).Offset(1)[/COLOR]
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Anh xem dùm em, em thêm vào, sao nó lại copy lại trùng nhiều lần
 
Lần chỉnh sửa cuối:
Mã:
Private Sub Worksheet_Activate()
    Dim Ws As Worksheet
    Dim i As Byte
    Application.ScreenUpdating = False
    [3:65536].Delete
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> "Luong" Then
[COLOR=#ff0000]            For i = 2 To Sheets.Count[/COLOR]
[COLOR=#ff0000]                Sheets(i).[3:1000].Copy [A65536].End(xlUp).Offset(1)[/COLOR]
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Anh xem dùm em, em thêm vào, sao nó lại copy lại trùng nhiều lần
Trời đất, đã For Each Ws In ThisWorkbook.Worksheets rồi còn For i = 2 To Sheets.Count nữa thì nó trùng là đúng rồi chứ sao nữa. Bạn bỏ vòng For thứ 2 đi nhé.

P/S: Thêm nữa, thay vì gõ Sheets(i).[3:1000] thì bạn gõ Ws.[3:1000] nhé.
 
Lần chỉnh sửa cuối:
Bạn sử dụng code này thay cho code trên nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim Ws As Worksheet
    Application.ScreenUpdating = False
    [3:65536].Delete
    For Each Ws In ThisWorkbook.Worksheets
        If InStr(".A.C.", "." & Ws.Name & ".") > 0 Then
            With Ws.Range("A3:P" & Ws.[A65536].End(xlUp).Row)
                [A65536].End(xlUp).Offset(1).Resize(.Rows.Count, 16).Value = .Value
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Để thay đổi danh sách các sheet cần tổng hợp, bạn thay đổi chuỗi ".A.C." nhé (các tên sheet được đặt giữa 2 dấu chấm để phòng trường hợp có nhiều tên sheet gần giống nhau kiểu như Sheet1, Sheet10, Sheet11,...)


Ủa anh sao code này thi nó lại tổng hợp thêm 1 dòng tiêu đề nữa vậy
 
e không rành lắm về code vba nhưng giờ đang rất cần làm 1 file excel để tổng hợp từ các sheet. e có tham khảo topic của anh :
http://www.giaiphapexcel.com/forum/showthread.php?56985-T%E1%BB%95ng-h%E1%BB%A3p-nhi%E1%BB%81u-sheet-th%C3%A0nh-1-sheet/page2


File của e cụ thể như sau:
4 sheet: tong hop, q1, q2,q3, q9
mỗi sheet có các cột: stt, quận/huyện, thời gian, ghi chú

e làm thì nó gộp cũng được thành 1 sheet như a hướng dẫn nhưng a có thể giúp e thêm tí nữa được ko anh?
1. sheet tong hop cái cot stt no tu nhay theo thứ tự của nó (hiện tại nó coppy từ các sheet)
2. thứ tự các dòng trong sheet tong hop dươc sap xep theo thoi gian
3. sheet tong hop tự sắp theo quận/huyện (vd: khi cập nhật ở các sheet q1,2,3,9 thì bên sheet tong hop se hiển thị theo dòng hết q1 mới đến q2 roi den q3, q9.)

rất vui nếu được a giúp đỡ. vì không có thông tin sđt hay mail/ yahoo anh nên phải nhắn qua mail này. mong a thông cảm.
nếu được a có thể reply giúp e qua mail cnttmbs@gmail.com nha. tks rất nhièu
 

File đính kèm

  • Book2.xls
    26 KB · Đọc: 52
dear anh Phúc
trong sheet tổng hợp đc sắp xếp theo thứ tự của các sheet 1, sheet 2
có cách nào nó tự động sắp xếp theo thời gian đc ko anh
 
mình muốn khi nhấn vô 1 nhãn "tong hop sheet" trong sheet TONG HOP thì nó sẽ thu thập thông tin từ các sheet còn lại, trừ sheet Ref ra, mình có làm theo chổ anh phúc hướng dẫn nhưng nó chỉ lấy giá trị cuối thôi, mong được sự giúp đỡ của mọi người, thank!
 

File đính kèm

  • TONG HOP SHEET.xlsm
    72.5 KB · Đọc: 19
mình muốn khi nhấn vô 1 nhãn "tong hop sheet" trong sheet TONG HOP thì nó sẽ thu thập thông tin từ các sheet còn lại, trừ sheet Ref ra, mình có làm theo chổ anh phúc hướng dẫn nhưng nó chỉ lấy giá trị cuối thôi, mong được sự giúp đỡ của mọi người, thank!
Nguyên nhân là các sheet thành phần của bạn không đồng bộ. Sheet thì nhập từ hàng 2, sheet thì nhập từ hàng 3. Với những bài toán tổng hợp từ nhiều sheet hoặc nhiều file thì cấu trúc file/bảng và quy ước nhập phải được thống nhất và đồng bộ, ngược lại thì việc tổng hợp sẽ khó và dễ sai sót.
 
mình muốn khi nhấn vô 1 nhãn "tong hop sheet" trong sheet TONG HOP thì nó sẽ thu thập thông tin từ các sheet còn lại, trừ sheet Ref ra, mình có làm theo chổ anh phúc hướng dẫn nhưng nó chỉ lấy giá trị cuối thôi, mong được sự giúp đỡ của mọi người, thank!
Với dữ liệu hiện có trong file thì bạn dùng code này nhé:
Mã:
Private Sub Worksheet_Activate()
    Dim i As Long, fR As Long, lR As Long, Rws As Long
    Application.ScreenUpdating = False
    [2:65000].Delete 'Xoa du lieu hien co
    Sheets(Array("TONGHOP", "Ref")).Move Before:=Sheets(1) 'Di chuyen sheet len dau
    For i = 3 To Sheets.Count 'Lam viec voi sheet thu 3 tro di (tru sheet TONGHOP va Ref)
        lR = Sheets(i).[A65000].End(xlUp).Row 'Xac dinh dong cuoi chua du lieu
        If lR > 1 Then 'Neu co du lieu thi thuc hien
            fR = 2 'Xac dinh dong dau cua sheet i
            Do While Sheets(i).Cells(fR, 1) = ""
                fR = fR + 1 'Xac dinh dong dau chua du lieu cua sheet i
            Loop
            Rws = lR - fR + 1 'So dong du lieu cua sheet i
            [A65000].End(xlUp).Offset(1).Resize(Rws, 18).Value = Sheets(i).Cells(fR, 1).Resize(Rws, 18).Value 'Copy gia tri qua sheet TONGHOP
        End If
    Next
    ActiveSheet.ListObjects("TongHop").Resize Range("A1:R" & [A65000].End(xlUp).Row) 'Mo rong Table TongHop
    Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • TONG HOP SHEET.xlsm
    71.7 KB · Đọc: 86
Web KT
Back
Top Bottom