Nhờ mọi người giúp về Gộp sheet

[mshuyenvn]

Nhờ mọi người xem file giúp em,

Em có sử dụng code trong diễn đàn và sửa lại cho phù hợp với file.
Nhưng mà k chạy ra được dữ liệu.
Tiện thể, nhờ mọi người giúp viết code - Ở mỗi sheet, lấy thêm dữ liệu ở B7 và I7
Em xin chân thành cảm ơn!

 

[snow25]

Nhờ mọi người xem file giúp em,

Em có sử dụng code trong diễn đàn và sửa lại cho phù hợp với file.
Nhưng mà k chạy ra được dữ liệu.
Tiện thể, nhờ mọi người giúp viết code - Ở mỗi sheet, lấy thêm dữ liệu ở B7 và I7
Em xin chân thành cảm ơn!

Code nó vẫn hoạt động chẳng qua là nó chạy xuống dưới thôi.Bạn xóa hết dữ liệu trong sheets tong hop đó đi rồi chạy lại là được.

 

[mshuyenvn]

Code nó vẫn hoạt động chẳng qua là nó chạy xuống dưới thôi.Bạn xóa hết dữ liệu trong sheets tong hop đó đi rồi chạy lại là được.

Em làm được rồi ạ. ^^

Option Explicit

Sub TongHop()

Dim Ws As Worksheet, aWs As Worksheet
Set aWs = Worksheets("Sheet1")
Dim Arr, ARR2, ARR3

For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> aWs.Name Then
Arr = Ws.Range("A18:K" & Ws.Range("K65000").End(xlUp).Row).Value
ARR2 = Ws.Range("B7").Value
ARR3 = Ws.Range("I7").Value
aWs.Range("A" & aWs.Range("A65000").End(xlUp).Row + 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
aWs.Range("L" & aWs.Range("L65000").End(xlUp).Row + 1).Resize(UBound(Arr, 1)).Value = Ws.Name
aWs.Range("M" & aWs.Range("M65000").End(xlUp).Row + 1).Resize(UBound(Arr, 1)).Value = ARR2
aWs.Range("N" & aWs.Range("N65000").End(xlUp).Row + 1).Resize(UBound(Arr, 1)).Value = ARR3
Arr = Empty
ARR2 = Empty
ARR3 = Empty

End If
Next



End Sub