GỘP NHIỀU SHEET THÀNH 1 SHEET TỔNG

tuquyen1711 · 17/12/18

Chào cả nhà,
Em có 1 file cần gộp nhiều sheet thành 1 sheet tổng, em có lên mạng search và dán đoạn code vào, làm thành công lần đầu tiên.
Nhưng từ lần thứ 2 thì em không thể gộp nữa ạ.
Nhờ mọi người hướng dẫn giúp em.
Em cám ơn ạ.
Đây là đoạn code em có lên mạng tìm:

Sub MergeSheets()
Const NHR = 1

Dim MWS As Worksheet
Dim AWS As Worksheet
Dim FAR As Long
Dim LR As Long

Set AWS = ActiveSheet

For Each MWS In ActiveWindow.SelectedSheets
If Not MWS Is AWS Then
FAR = AWS.UsedRange.Cells(AWS.UsedRange.Cells.Count).Row + 1
LR = MWS.UsedRange.Cells(MWS.UsedRange.Cells.Count).Row
MWS.Range(MWS.Rows(NHR + 1), MWS.Rows(LR)).Copy AWS.Rows(FAR)
End If
Next MWS
End Sub

snow25 · 17/12/18

tuquyen1711 đã viết:
Chào cả nhà,
Em có 1 file cần gộp nhiều sheet thành 1 sheet tổng, em có lên mạng search và dán đoạn code vào, làm thành công lần đầu tiên.
Nhưng từ lần thứ 2 thì em không thể gộp nữa ạ.
Nhờ mọi người hướng dẫn giúp em.
Em cám ơn ạ.
Đây là đoạn code em có lên mạng tìm:

Sub MergeSheets()
Const NHR = 1

Dim MWS As Worksheet
Dim AWS As Worksheet
Dim FAR As Long
Dim LR As Long

Set AWS = ActiveSheet

For Each MWS In ActiveWindow.SelectedSheets
If Not MWS Is AWS Then
FAR = AWS.UsedRange.Cells(AWS.UsedRange.Cells.Count).Row + 1
LR = MWS.UsedRange.Cells(MWS.UsedRange.Cells.Count).Row
MWS.Range(MWS.Rows(NHR + 1), MWS.Rows(LR)).Copy AWS.Rows(FAR)
End If
Next MWS
End Sub

Bạn muốn thế nào.Code không chạy chỗ nào.Gửi cái File lên với cần tổng hợp thế nào nhé.

tuquyen1711 · 17/12/18

snow25 đã viết:
Bạn muốn thế nào.Code không chạy chỗ nào.Gửi cái File lên với cần tổng hợp thế nào nhé.

dạ, file của em có 3 sheet không hỉu sao nó nặng 27.393 kb, nên em không up lên được ạ

Bài đã được tự động gộp: 17/12/18

dạ, e copy từng sheet qua file khác thì nhẹ hơn rồi ạ, e gửi lại file ạ

snow25 · 17/12/18

tuquyen1711 đã viết:
dạ, file của em có 3 sheet không hỉu sao nó nặng 27.393 kb, nên em không up lên được ạ

Bài đã được tự động gộp: 17/12/18

dạ, e copy từng sheet qua file khác thì nhẹ hơn rồi ạ, e gửi lại file ạ

Đây bạn xem.

Mã:

Sub tonghop()
Dim arr
Dim lr As Long, a As Long
Dim sh As Worksheet
Dim tong As Worksheet
Set tong = Sheets("tong hop")
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "Tong hop" Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 1 Then
          arr = sh.Range("A2:k" & lr).Value
          a = tong.Range("B" & Rows.Count).End(xlUp).Row + 1
          tong.Range("A" & a).Resize(UBound(arr, 1), 11).Value = arr
          Erase arr
       End If
    End If
Next
MsgBox "Da tong hop xong"
End Sub

le_vis · 17/12/18

snow25 đã viết:

Đây bạn xem.

Mã:

Sub tonghop()
Dim arr
Dim lr As Long, a As Long
Dim sh As Worksheet
Dim tong As Worksheet
Set tong = Sheets("tong hop")
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "Tong hop" Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 1 Then
          arr = sh.Range("A2:k" & lr).Value
          a = tong.Range("B" & Rows.Count).End(xlUp).Row + 1
          tong.Range("A" & a).Resize(UBound(arr, 1), 11).Value = arr
          Erase arr
       End If
    End If
Next
MsgBox "Da tong hop xong"
End Sub

Thầy snow25 ơi - Với code trên thầy có thể xử lý khi click nút tổng hợp lần thứ 2 nó set lại và chỉ tổng hợp thêm phát sinh mới của các Sheet mà chưa có bên bảng tổng hợp thì cập nhật tiếp vào - Hiện tại nó cập nhật lại từ đầu thêm một lần nữa - Cảm ơn thầy

snow25 · 17/12/18

le_vis đã viết:
Thầy snow25 ơi - Với code trên thầy có thể xử lý khi click nút tổng hợp lần thứ 2 nó set lại và chỉ tổng hợp thêm phát sinh mới của các Sheet mà chưa có bên bảng tổng hợp thì cập nhật tiếp vào - Hiện tại nó cập nhật lại từ đầu thêm một lần nữa - Cảm ơn thầy

Đây bạn xem.Mà đừng gọi là thầy nhé.Mình không biết gì đâu.

Mã:

Sub tonghop()
Dim arr, arr1, arr2
Dim lr As Long, a As Long, b As Long, i As Long, j As Long, d As Long, c As Long
Dim dk As String
Dim sh As Worksheet
Dim dic As Object
Dim tong As Worksheet
Set dic = CreateObject("scripting.dictionary")
Set tong = Sheets("tong hop")
b = tong.Range("B" & Rows.Count).End(xlUp).Row
If b > 2 Then
   arr = tong.Range("B2:K" & b).Value
   For i = 1 To UBound(arr, 1)
     dk = Empty
      For j = 1 To 10
          If dk = Empty Then
             dk = arr(i, j)
          Else
             dk = dk & "#" & arr(i, j)
          End If
      Next j
      If dic.exists(dk) = 0 Then
         dic.Item(dk) = "KK"
      End If
  Next i
End If
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "Tong hop" Then
        c = sh.Range("B" & Rows.Count).End(xlUp).Row
        d = d + c
    End If
Next
ReDim arr1(1 To d, 1 To 11)
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "Tong hop" Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 1 Then
          arr2 = sh.Range("B2:K" & lr).Value
         For i = 1 To UBound(arr2, 1)
                dk = Empty
                For j = 1 To 10
                  If dk = Empty Then
                     dk = arr2(i, j)
                  Else
                     dk = dk & "#" & arr2(i, j)
                  End If
                Next j
                If dic.exists(dk) = 0 Then
                dic.Item(dk) = "KK"
                a = a + 1
                arr1(a, 1) = a + b - 1
                  For j = 2 To 11
                    arr1(a, j) = arr2(i, j - 1)
                  Next j
                End If
        Next i
      End If
   End If
Next
    If a Then tong.Range("A" & b + 1).Resize(a, 11).Value = arr1

MsgBox "Da cap nhap duoc :" & a & " dong"
End Sub

le_vis · 17/12/18

snow25 đã viết:

Đây bạn xem.Mà đừng gọi là thầy nhé.Mình không biết gì đâu.

Mã:

Sub tonghop()
Dim arr, arr1, arr2
Dim lr As Long, a As Long, b As Long, i As Long, j As Long, d As Long, c As Long
Dim dk As String
Dim sh As Worksheet
Dim dic As Object
Dim tong As Worksheet
Set dic = CreateObject("scripting.dictionary")
Set tong = Sheets("tong hop")
b = tong.Range("B" & Rows.Count).End(xlUp).Row
If b > 2 Then
   arr = tong.Range("B2:K" & b).Value
   For i = 1 To UBound(arr, 1)
     dk = Empty
      For j = 1 To 10
          If dk = Empty Then
             dk = arr(i, j)
          Else
             dk = dk & "#" & arr(i, j)
          End If
      Next j
      If dic.exists(dk) = 0 Then
         dic.Item(dk) = "KK"
      End If
  Next i
End If
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "Tong hop" Then
        c = sh.Range("B" & Rows.Count).End(xlUp).Row
        d = d + c
    End If
Next
ReDim arr1(1 To d, 1 To 11)
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "Tong hop" Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 1 Then
          arr2 = sh.Range("B2:K" & lr).Value
         For i = 1 To UBound(arr2, 1)
                dk = Empty
                For j = 1 To 10
                  If dk = Empty Then
                     dk = arr2(i, j)
                  Else
                     dk = dk & "#" & arr2(i, j)
                  End If
                Next j
                If dic.exists(dk) = 0 Then
                dic.Item(dk) = "KK"
                a = a + 1
                arr1(a, 1) = a + b - 1
                  For j = 2 To 11
                    arr1(a, j) = arr2(i, j - 1)
                  Next j
                End If
        Next i
      End If
   End If
Next
    If a Then tong.Range("A" & b + 1).Resize(a, 11).Value = arr1

MsgBox "Da cap nhap duoc :" & a & " dong"
End Sub

Xin cảm ơn ! Quá chuẩn. Nếu bên bảng tổng hợp nó tự động dãn dòng và cập nhật kế tiếp phần thêm mới của trang nào kế tiếp vào trang nấy thì mỹ mãn quá thầy ạ - Xin lỗi vì sự làm phiền này

lequocsuc3vvk · 22/12/18

Cho hỏi nếu tôi có các sheet giống nhau cấu trúc nhưng cột Điểm TL ở các sheet khác nhau. Tôi muốn gộp lại vào sheet tổng hợp thì làm sao?

snow25 · 22/12/18

lequocsuc3vvk đã viết:
Cho hỏi nếu tôi có các sheet giống nhau cấu trúc nhưng cột Điểm TL ở các sheet khác nhau. Tôi muốn gộp lại vào sheet tổng hợp thì làm sao?

Bạn muốn gộp thế nào.Gộp các điểm DL lại với nhau à.Hay là thế nào.

lequocsuc3vvk · 22/12/18

Vì các sheet do 3 người nhập Điểm TL nên tôi muốn có một sheet tổng hợp là gộp các các điểm vào lại với nhau

snow25 · 22/12/18

lequocsuc3vvk đã viết:
Vì các sheet do 3 người nhập Điểm TL nên tôi muốn có một sheet tổng hợp là gộp các các điểm vào lại với nhau

Vậy trong trường hợp có 1 học sinh được 2 người cùng nhập thì giải quyết kiểu gì.

lequocsuc3vvk · 22/12/18

Vì mỗi người có điểm ở các phòng khác nhau. Nếu bị trùng thì hiện báo lỗi dùm!

snow25 · 22/12/18

lequocsuc3vvk đã viết:
Vì mỗi người có điểm ở các phòng khác nhau. Nếu bị trùng thì hiện báo lỗi dùm!

Vậy cái file của bạn đưa lên trùng nhiều lắm.Bạn đưa file khác lên nhé.Hoặc là nếu trùng thì mình lấy điểm đầu tiên.

lequocsuc3vvk · 22/12/18

snow25 đã viết:
Vậy cái file của bạn đưa lên trùng nhiều lắm.Bạn đưa file khác lên nhé.Hoặc là nếu trùng thì mình lấy điểm đầu tiên.

Chỉ kiểm trùng cột L là cột Điểm TL đã tô màu vàng

snow25 · 22/12/18

lequocsuc3vvk đã viết:
Chỉ kiểm trùng cột L là cột Điểm TL đã tô màu vàng

Đây bạn xem.

lequocsuc3vvk · 22/12/18

Cảm ơn nhiều!
Cho hỏi thêm là nếu có 2 cột cần hợp lại như vậy, hay nhiều hơn thì sửa code ra sao?
Chân thành cảm ơn trước nhé!

lequocsuc3vvk · 24/7/19

Mọi người cho tôi hỏi là tôi có cột họ và tên nhân viên. Tôi muốn phân công họ kiểm tra lẫn nhau từng đôi một ngẫu nhiên. Và danh sách liền kề cột bên phải. Thì phải làm sao ạ!

khongcan · 13/8/19

lequocsuc3vvk đã viết:
Mọi người cho tôi hỏi là tôi có cột họ và tên nhân viên. Tôi muốn phân công họ kiểm tra lẫn nhau từng đôi một ngẫu nhiên. Và danh sách liền kề cột bên phải. Thì phải làm sao ạ!

Tôi đọc câu hỏi của bạn mà mãi không hiểu bạn định hỏi cái gì?
Sao bạn không post file yêu cầu và kết quả ví dụ lên để mọi người có thể giúp bạn?

xaydung.vig · 14/8/19

Bác Snow25 làm thế nào mà tạo ra được cái nút "tổng hợp" chỉ cần nhấn 1 cái nó tự tổng hợp vậy?

Lê Hồng Minh83 · 14/8/19

xaydung.vig đã viết:
Bác Snow25 làm thế nào mà tạo ra được cái nút "tổng hợp" chỉ cần nhấn 1 cái nó tự tổng hợp vậy?

cái đó là gán code VBA cho cái nút thôi, thực tế là cái code nó mới "tổng hợp", còn cái nút nó chỉ để chạy cái code thôi

GỘP NHIỀU SHEET THÀNH 1 SHEET TỔNG

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên tích cực

Thành viên gạo cội

File đính kèm

Thành viên tích cực

Super Сasual Dating - Authentic Damsels

File đính kèm

Thành viên gạo cội

Super Сasual Dating - Authentic Damsels

Thành viên gạo cội

Super Сasual Dating - Authentic Damsels

Thành viên gạo cội

Super Сasual Dating - Authentic Damsels

Thành viên gạo cội

File đính kèm

Super Сasual Dating - Authentic Damsels

Super Сasual Dating - Authentic Damsels

Thành viên mới

Thành viên mới

Thành viên tiêu biểu

Facebook

Group