Tự động lấy dữ liệu từ sheet chi tiết sang sheet tổng hợp.

[Hananiki]

Em có dữ liệu cần tổng hợp từ các sheet chi tiết sang sheet tổng hợp (một sheet tổng hợp nhưng nhiều sheet chi tiết khi thêm mã CT sẽ tương ứng với sheet đo.
sheet chi tiết theo biểu mẫu không bị thay đổi.
ở sheet tổng hợp những ô được tô màu vàng sẽ lấy dữ liệu ở những ô tương ứng ở sheet chi tiết.

Mọi người chỉ giúp em.

 

[nghiaphuc]

Bạn nhấn nút Sửa bài viết và chỉnh sửa lại đi chứ trình bày như vậy khó đọc quá.

Bạn dùng code sau xem sao:
[GPECODE=vb]Sub Test()
Dim Cll As Range, i As Long, Wf
With Application
.ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual
End With
Set Wf = WorksheetFunction
Sheets("Tong hop").Move Before:=Sheets(1)
Sheets("Mau").Move After:=Sheets(Sheets.Count)
For Each Cll In Sheets("Tong hop").[B7:B10]
For i = 2 To Sheets.Count
If UCase(Sheets(i).[H1]) = UCase(Cll) Then Exit For
Next
If i < Sheets.Count Then
Cll.Offset(, 4).Resize(, 2).Value = Wf.Transpose(Sheets(i).[E7:E8])
Cll.Offset(, 7).Resize(, 4).Value = Wf.Transpose(Sheets(i).[E11:E14])
Cll.Offset(, 12).Resize(, 8).Value = Wf.Transpose(Sheets(i).[E17:E24])
Cll.Offset(, 25).Value = Wf.Transpose(Sheets(i).[E26])
Cll.Offset(, 27).Value = Wf.Transpose(Sheets(i).[E25])
End If
Next
Sheets("Tong hop").Select
With Application
.ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
End With
End Sub[/GPECODE]

 

[Hananiki]

File em đưa lên chỉ có 2 sheet chi tiết nhưng thực tế là em sẽ có rất nhiều sheet như vậy.
Em đã thử thêm 1 sheet chi tiết mới nhưng mà file excel không cho thêm mà nó báo lỗi.
Anh sửa giup em lỗi này (ảnh kèm theo)

 

[nghiaphuc]

File em đưa lên chỉ có 2 sheet chi tiết nhưng thực tế là em sẽ có rất nhiều sheet như vậy.
Em đã thử thêm 1 sheet chi tiết mới nhưng mà file excel không cho thêm mà nó báo lỗi.
Anh sửa giup em lỗi này (ảnh kèm theo)

Việc thêm sheet thì liên quan gì đến việc Path/File access nhỉ?!
Liệu trong file thực tế của bạn có code gì trong đối tượng ThisWorkbook (chẳng hạn Sub Workbook_NewSheet) hay có Add-ins nào điều khiển việc thêm sheet này không?

 

[Hananiki]

Trong file của em thì em không biết chính xác có nội dung anh bảo không.
Nhưng em có cài thêm add-in TVEXCEL02 Print của diễn đàn nên không biết nó có ảnh hưởng không.

 

[nghiaphuc]

Trong file của em thì em không biết chính xác có nội dung anh bảo không.
Nhưng em có cài thêm add-in TVEXCEL02 Print của diễn đàn nên không biết nó có ảnh hưởng không.

Bạn thử thêm sheet bằng code sau xem có vấn đề gì không:
[GPECODE=vb]Sub AddSheet()
On Error GoTo Err
With Application
.ScreenUpdating = False: .DisplayAlerts = False
End With
Sheets("Mau").Copy Before:=Sheets("Mau")
ActiveSheet.Name = InputBox("Nhap ten sheet:")
ActiveSheet.[H1] = ActiveSheet.Name
With Application
.ScreenUpdating = True: .DisplayAlerts = True
End With
Exit Sub
Err:
MsgBox "Ten sheet khong hop le!"
ActiveSheet.Delete
With Application
.ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub[/GPECODE]
Khi chạy code, sheet Mau sẽ được copy thành 1 bản mới và đặt tên theo người dùng nhập vào, đồng thời gán tên sheet đó vào ô H1. Nếu tên nhập vào không hợp lệ thì sẽ xóa sheet mới copy này đi.