Em muốn hỏi về cách tổng hợp các sheet thành 1 sheet tổng hợp (3 người xem)

[van_utc]

Em có bảng có nhiều sheet. Mỗi sheet có các cột dữ liệu trong đó sẽ có dữ liệu cột này của sheet này trùng với dữ liệu cột kia của sheet kia.
Các anh chị giúp em đặt công thức để nó tổng hợp lại thành 1 sheet tổng hợp mà dữ liệu sắp xếp đúng với nhau không ạ?
Em có gửi file đính kèm đây ạ. Em cảm ơn ạ.

 

[phulien1902]

Em có bảng có nhiều sheet. Mỗi sheet có các cột dữ liệu trong đó sẽ có dữ liệu cột này của sheet này trùng với dữ liệu cột kia của sheet kia.
Các anh chị giúp em đặt công thức để nó tổng hợp lại thành 1 sheet tổng hợp mà dữ liệu sắp xếp đúng với nhau không ạ?
Em có gửi file đính kèm đây ạ. Em cảm ơn ạ.

To @an_utc
Bạn sửa tên Sheets("Tổng hợp") thành Sheets("Tonghop"), rồi chạy Code

Sub abc()
    Dim sh As Worksheet
    Sheets("Tonghop")..Cells.ClearContents
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Tonghop" Then
            sh.Range("A1").CurrentRegion.Copy Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1)
        End If
    Next
    Columns(1).Delete
End Sub

 

[HieuCD]

Em có bảng có nhiều sheet. Mỗi sheet có các cột dữ liệu trong đó sẽ có dữ liệu cột này của sheet này trùng với dữ liệu cột kia của sheet kia.
Các anh chị giúp em đặt công thức để nó tổng hợp lại thành 1 sheet tổng hợp mà dữ liệu sắp xếp đúng với nhau không ạ?
Em có gửi file đính kèm đây ạ. Em cảm ơn ạ.

Sub GPE()
  Dim sh As Worksheet, sArr(), Res As Variant
  Dim i As Long, ik As Long, sRow As Long
  Dim k As Byte, j As Byte, jk As Byte, sCol As Byte
  
  For Each sh In ThisWorkbook.Sheets
    If sh.Name <> Sheet5.Name Then
      If sRow = 0 Then sRow = sh.Range("A1").CurrentRegion.Rows.Count
      sCol = sCol + sh.Range("A1").CurrentRegion.Columns.Count
    End If
  Next
  ReDim Res(1 To sRow, 1 To sCol)
  
  With CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Sheets
      If sh.Name <> Sheet5.Name Then
        sArr = sh.Range("A1").CurrentRegion.Value
        sRow = UBound(sArr, 1):        sCol = UBound(sArr, 2)
        
        For j = 1 To sCol
          Res(1, j + jk) = sArr(1, j)
        Next j
        
        k = k + 1
        For i = 2 To sRow
          Key = sArr(i, sCol) & "#" & k - 1
          ik = 0
          If .exists(Key) Then ik = .Item(Key) Else If k = 1 Then ik = i
          If ik > 0 Then
            .Item(sArr(i, 1) & "#" & k) = ik
            For j = 1 To sCol
              Res(ik, j + jk) = sArr(i, j)
            Next j
          End If
        Next i
      End If
      jk = jk + sCol
    Next
  End With
  Sheet5.Range("A1").CurrentRegion.ClearContents
  Sheet5.Range("A1").Resize(UBound(Res), UBound(Res, 2)) = Res
End Sub

 

[van_utc]

Bây giờ em mới reply or like bài viết. Tự nhiên diễn đàn khóa em. Hic

 

[Ba Tê]

Bạn thử:

Sub abc()
    Dim sh As Worksheet
    Sheet5.Cells.ClearContents
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Sheet5" Then
            sh.Range("A1").CurrentRegion.Copy Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1)
        End If
    Next
    Columns(1).Delete
End Sub

Bạn có kiểm tra kết quả chưa?
Sao kết quả nó ra "gấp đôi" vậy ta?

Địa chỉ không rõ ràng.
"Sheet5" không phải là sh.Name
Sửa lại tên sheet5 thành "TongHop".
Sửa Sub như vầy cho "chắc cú"

Sub abc()
Dim sh As Worksheet
    With Sheets("TongHop")
        .Cells.ClearContents
        For Each sh In ThisWorkbook.Worksheets
            If sh.Name <> "TongHop" Then
                sh.Range("A1").CurrentRegion.Copy .Cells(1, .Cells(1, Columns.Count).End(xlToLeft).Column + 1)
            End If
        Next sh
        .Columns(1).Delete
    End With
End Sub

To @van_utc : Bạn muốn "chơi" với Excel một cách thoải mái thì không nên đặt tên Sheets có dấu tiếng Việt.

 

[van_utc]

Mọi người đã giúp em nhưng em không biết VBA nên mọi người viết luôn vào file cho em có được không ạ?
Thêm nữa, đây là ví dụ tiêu biểu em hay phải làm; em muốn hỏi các code này có tiếp tục chạy đúng nếu như em thêm cột trong các sheet không ạ? Hoặc em thay đổi tên cột thì code có chạy đúng nữa không? Mục đích cuối của em vẫn là sheet Tổng hợp sẽ liệt kê tất cả các cột của các sheet vào sheet Tổng hợp và thỏa mãn sắp xếp thứ tự tương thích với nhau ạ.

 

[phulien1902]

Trong các Sheets mà bạn cần tổng hợp, cho dù bạn có tăng thêm cột. Khi chạy Code vẫn cho kết quả đúng, có 1 điều lưu ý là các cột của bạn thêm vào phải liên tục. Vậy thôi.

 

[truongvu317]

To @an_utc
Bạn sửa tên Sheets("Tổng hợp") thành Sheets("Tonghop"), rồi chạy Code

Sub abc()
    Dim sh As Worksheet
    Sheets("Tonghop")..Cells.ClearContents
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Tonghop" Then
            sh.Range("A1").CurrentRegion.Copy Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1)
        End If
    Next
    Columns(1).Delete
End Sub

Chắc chưa đọc đoạn này.

có dữ liệu cột này của sheet này trùng với dữ liệu cột kia của sheet kia.

 

[Ba Tê]

Mọi người đã giúp em nhưng em không biết VBA nên mọi người viết luôn vào file cho em có được không ạ?

Bạn biết mở file có Macros không?