Tổng hợp dữ liệu từ nhiều sheet trong 1 file excel (khác định dạng cột) (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

duong phu khai

Thành viên mới
Tham gia
21/11/18
Bài viết
2
Được thích
0
Chào anh chị diễn đàn, em có vấn đề liên quan đến tổng hợp dữ liệu tại nhiều sheet trong 1 file mong được anh chị chỉ bảo:
Em có nhận được 1 file kế toán tổng hợp dữ liệu bao gồm 15 sheet - (tương ứng 15 tháng từ 01/2022 - 03/2023), em đang muốn gom lại dữ liệu của 15 sheet đó vào chung 1 sheet tổng hợp. Tuy nhiên vấn đề là dòng 5 của mỗi sheet tiêu đề đơn vị thì nội dung các cột không đồng nhất theo từng tháng. nên em không thao tác theo power querry được.
Mong anh/chị chỉ giúp em cách nào để giải quyết ? Em cám ơn anh/chị nhiều
 

File đính kèm

Chào anh chị diễn đàn, em có vấn đề liên quan đến tổng hợp dữ liệu tại nhiều sheet trong 1 file mong được anh chị chỉ bảo:
Em có nhận được 1 file kế toán tổng hợp dữ liệu bao gồm 15 sheet - (tương ứng 15 tháng từ 01/2022 - 03/2023), em đang muốn gom lại dữ liệu của 15 sheet đó vào chung 1 sheet tổng hợp. Tuy nhiên vấn đề là dòng 5 của mỗi sheet tiêu đề đơn vị thì nội dung các cột không đồng nhất theo từng tháng. nên em không thao tác theo power querry được.
Mong anh/chị chỉ giúp em cách nào để giải quyết ? Em cám ơn anh/chị nhiều
Gom như thế nào ?
 
Chào anh chị diễn đàn, em có vấn đề liên quan đến tổng hợp dữ liệu tại nhiều sheet trong 1 file mong được anh chị chỉ bảo:
Em có nhận được 1 file kế toán tổng hợp dữ liệu bao gồm 15 sheet - (tương ứng 15 tháng từ 01/2022 - 03/2023), em đang muốn gom lại dữ liệu của 15 sheet đó vào chung 1 sheet tổng hợp. Tuy nhiên vấn đề là dòng 5 của mỗi sheet tiêu đề đơn vị thì nội dung các cột không đồng nhất theo từng tháng. nên em không thao tác theo power querry được.
Mong anh/chị chỉ giúp em cách nào để giải quyết ? Em cám ơn anh/chị nhiều
Thao khảo thử code này:
Mã:
Sub TongHop()
    Dim Ws As Worksheet, Rng As Range, iRow&, R&
    Dim Dic As Object, Sh As Worksheet, iC&, sC&, j&
    Set Sh = Sheets("KetQua")
    Application.ScreenUpdating = 0
    Set Dic = CreateObject("Scripting.dictionary")
    Sheets("KetQua").Range("A1").Resize(10000, 1000).Clear
    For Each Ws In Worksheets
        If Ws.Name <> "KetQua" Then
            iRow = Sh.Range("E" & Rows.Count).End(3).Row
            If iRow < 2 Then iRow = 2 Else iRow = iRow + 1
            Sh.Range("B" & iRow).Resize(130).Value = Ws.Name
            Set Rng = Ws.Range("A6:C135")
            Rng.Copy
            Sh.Range("C" & iRow).PasteSpecial xlPasteValues
            iC = Ws.Cells(5, Columns.Count).End(1).Column
            For j = 4 To iC - 1
                sC = Sh.Cells(1, Columns.Count).End(1).Column
                If sC < 6 Then sC = 6 Else sC = sC + 1
                If Dic.exists(Ws.Cells(5, j).Value) = False Then
                    Dic.Add Ws.Cells(5, j).Value, sC
                    Sh.Cells(1, sC).Value = Ws.Cells(5, j).Value
                    Ws.Cells(6, j).Resize(130).Copy
                    Sh.Cells(iRow, sC).PasteSpecial xlPasteValues
                Else
                    R = Dic.Item(Ws.Cells(5, j).Value)
                    Ws.Cells(6, j).Resize(130).Copy
                    Sh.Cells(iRow, R).PasteSpecial xlPasteValues
                End If
            Next
        End If
    Next
    With Sh
        .Cells(1, 2).Resize(iRow + 130, sC - 1).Borders.LineStyle = 1
        .Cells(1, sC).Value = "TONG"
        .Cells(3, sC).FormulaR1C1 = "=SUM(RC[-" & sC - 6 & "]:RC[-1])"
        .Cells(3, sC).Copy
        .Cells(4, sC).Resize(iRow + 126).PasteSpecial xlPasteFormulas
        .Range("F1").Resize(, sC - 5).EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = 1
End Sub
 
Web KT

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

Back
Top Bottom