Xin code để tổng hợp nhanh số liệu và tính % từ nhiều sheet (có định dạng giống nhau)

[thamcivil]

Mình có file mẫu chất lượng cuối năm gửi về nhiều đơn vị trường học, rồi tổng hợp lại thành file chung.
Nhờ các anh chị chỉ giúp code để tổng hợp nhanh.
Xin cảm ơn.

 

[Ba Tê]

Mình có file mẫu chất lượng cuối năm gửi về nhiều đơn vị trường học, rồi tổng hợp lại thành file chung.
Nhờ các anh chị chỉ giúp code để tổng hợp nhanh.
Xin cảm ơn.

Cấu trúc dòng cột các sheets giống nhau, Bạn chạy thử Sub này rồi kiểm tra kết quả xem sao.
-------------------------------------
Oái! Còn chưa xem kỹ các cột tính %.

 

[Binbo2020]

tổng hợp lại thành file chung

VBA mình không biết nhưng file có cấu trúc giống hệt nhau thế này chỉ là cộng các sheet lại với nhau thôi sao không dùng công thức 3D để có thể thay đổi tự sửa được nhỉ

 

[ptm0412]

F10 =SUM('TH X1:TH Xn'!F10)
Copy cho các ô còn lại

 

[HUONGHCKT]

Mình có file mẫu chất lượng cuối năm gửi về nhiều đơn vị trường học, rồi tổng hợp lại thành file chung.
Nhờ các anh chị chỉ giúp code để tổng hợp nhanh.
Xin cảm ơn

Thêm cho bạn 1 cách dùng VBA cho rộng đường lựa chọn.
hãy nhấn nút THOP và kiểm tra kết quả.

 

[thamcivil]

Cấu trúc dòng cột các sheets giống nhau, Bạn chạy thử Sub này rồi kiểm tra kết quả xem sao.
-------------------------------------
Oái! Còn chưa xem kỹ các cột tính %.

Thêm cho bạn 1 cách dùng VBA cho rộng đường lựa chọn.
hãy nhấn nút THOP và kiểm tra kết quả.

Cảm ơn các anh chị quan tâm chỉ bảo giúp

Bài đã được tự động gộp: 5/8/21

F10 =SUM('TH X1:TH Xn'!F10)
Copy cho các ô còn lại

Cảm ơn bạn đã chỉ giúp

 

[Ba Tê]

Cấu trúc dòng cột các sheets giống nhau, Bạn chạy thử Sub này rồi kiểm tra kết quả xem sao.
-------------------------------------
Oái! Còn chưa xem kỹ các cột tính %.

Các ô công thức tính % phải có đầy đủ trong sheet2.
Lấy luôn công thức các ô này sang Tổng hợp, nếu không muốn "nhìn" công thức thì xài luôn dòng lệnh cuối.

Option Explicit

Public Sub GPE()
Const xRow As Long = 118, xCol As Long = 24
Dim Ws As Worksheet, sArr(), dArr(1 To xRow, 1 To xCol), I As Long, J As Long
For Each Ws In ThisWorkbook.Worksheets
    If Ws.CodeName <> "Sheet1" Then
        sArr = Ws.Range("B9").Resize(xRow, xCol).Value
        For I = 1 To xRow
            For J = 1 To xCol Step 2
                dArr(I, J) = dArr(I, J) + sArr(I, J)
            Next J
        Next I
    End If
Next Ws
    sArr = Sheet2.Range("B9").Resize(xRow, xCol).FormulaR1C1
    For I = 1 To xRow
        For J = 2 To xCol Step 2
            dArr(I, J) = sArr(I, J)
        Next J
    Next I
Sheet1.Range("B9").Resize(xRow, xCol) = dArr
'Sheet1.Range("B9").Resize(xRow, xCol) = Sheet1.Range("B9").Resize(xRow, xCol).Value'
End Sub