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

hoangexcell

Thành viên thường trực
Tham gia ngày
8 Tháng một 2008
Bài viết
398
Được thích
108
Điểm
695
Nơi ở
Thủ Đức
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

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,528
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
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

hoangexcell

Thành viên thường trực
Tham gia ngày
8 Tháng một 2008
Bài viết
398
Được thích
108
Điểm
695
Nơi ở
Thủ Đức
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
 

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,528
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
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,...)
 

tungbanj

Thành viên mới
Tham gia ngày
28 Tháng ba 2009
Bài viết
1
Được thích
0
Điểm
663
Tuổi
34
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é
 

huuduy.duy

Thành viên tiêu biểu
Tham gia ngày
29 Tháng mười 2010
Bài viết
795
Được thích
87
Điểm
420
Nơi ở
Cà Mau
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
 

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,528
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
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
 

huuduy.duy

Thành viên tiêu biểu
Tham gia ngày
29 Tháng mười 2010
Bài viết
795
Được thích
87
Điểm
420
Nơi ở
Cà Mau
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, ...
 

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,528
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
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.
 

huuduy.duy

Thành viên tiêu biểu
Tham gia ngày
29 Tháng mười 2010
Bài viết
795
Được thích
87
Điểm
420
Nơi ở
Cà Mau
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:

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,528
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
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:

huuduy.duy

Thành viên tiêu biểu
Tham gia ngày
29 Tháng mười 2010
Bài viết
795
Được thích
87
Điểm
420
Nơi ở
Cà Mau
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
 

tranquochoang2013

Thành viên mới
Tham gia ngày
20 Tháng tám 2013
Bài viết
4
Được thích
0
Điểm
0
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

huongdk

Thành viên mới
Tham gia ngày
15 Tháng tám 2013
Bài viết
1
Được thích
0
Điểm
363
Tuổi
41
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
 

congchuacaibang88

Thành viên mới
Tham gia ngày
2 Tháng một 2011
Bài viết
3
Được thích
1
Điểm
365
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

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,528
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
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.
 

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,528
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
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

Top Bottom