Hỏi VBA gộp sheet

Liên hệ QC

kimanh6228

Thành viên mới
Tham gia
31/7/19
Bài viết
34
Được thích
2
Em chào cả nhà. Em không biết gì về VBA nhưng hay phải gộp file, gộp sheet lang thang trên mạng thì cg tìm đc code để làm.
Nhưng lúc được lúc không. thỉnh thoảng bị báo lỗi như dưới hình. Các bác xem sửa code giúp e với.
còn 1 vấn đề nữa cho e hỏi theo như hướng dẫn thì sau khi gộp các dữ liệu sẽ được tổng hợp vào 1 sheets mới,
e không biết e sai ở đâu mà các dữ liệu sẽ được gộp vào sheet cuối cùng mình chọn trước khi gộp, các bác thông não hộ e.
e cảm ơn ah!

1579492756507.png
 

File đính kèm

  • 20-A.xlsx
    72.7 KB · Đọc: 13
Em chào cả nhà. Em không biết gì về VBA nhưng hay phải gộp file, gộp sheet lang thang trên mạng thì cg tìm đc code để làm.
Nhưng lúc được lúc không. thỉnh thoảng bị báo lỗi như dưới hình. Các bác xem sửa code giúp e với.
còn 1 vấn đề nữa cho e hỏi theo như hướng dẫn thì sau khi gộp các dữ liệu sẽ được tổng hợp vào 1 sheets mới,
e không biết e sai ở đâu mà các dữ liệu sẽ được gộp vào sheet cuối cùng mình chọn trước khi gộp, các bác thông não hộ e.
e cảm ơn ah!

View attachment 231307
Mình có thấy module nào trong file đâu mà báo lỗi nhỉ. Rồi nếu bạn muốn tổng hợp thì tổng hợp vào sheets nào. vùng nào
Mà trong các sheet ấy. thấy dữ liệu cách quãng thế là có chủ đích gì à.
 
Mình có thấy module nào trong file đâu mà báo lỗi nhỉ. Rồi nếu bạn muốn tổng hợp thì tổng hợp vào sheets nào. vùng nào
Mà trong các sheet ấy. thấy dữ liệu cách quãng thế là có chủ đích gì à.
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

e làm theo code này bác ah. e muốn tổng hợp ra sheet mới, còn dữ liệu ngắt quãng thì không cần để ý, vì nó là dòng trống thôi ah
dữ liệu này các bộ phận khác gửi cho e, nên muốn muốn tổng hợp lại sau đó mới xóa dòng trống và chỉnh sửa dữ liệu
 
Em chào cả nhà. Em không biết gì về VBA nhưng hay phải gộp file, gộp sheet lang thang trên mạng thì cg tìm đc code để làm.
Nhưng lúc được lúc không. thỉnh thoảng bị báo lỗi như dưới hình. Các bác xem sửa code giúp e với.
còn 1 vấn đề nữa cho e hỏi theo như hướng dẫn thì sau khi gộp các dữ liệu sẽ được tổng hợp vào 1 sheets mới,
e không biết e sai ở đâu mà các dữ liệu sẽ được gộp vào sheet cuối cùng mình chọn trước khi gộp, các bác thông não hộ e.
e cảm ơn ah!

View attachment 231307
Tạo Sheet mới đặt tên là "TongHop"
Mã:
Option Compare Text
Sub MergeSheets()
  Dim shKQ As Worksheet, sh As Worksheet
  Dim eRow As Long, eRowKQ As Long

  Set shKQ = Sheets("TongHop")
  For Each sh In ThisWorkbook.Sheets
    If sh.Name Like "Máy?*" Then
      eRow = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
      If eRow > 2 Then
        eRowKQ = shKQ.Range("A" & Rows.Count).End(xlUp).Row + 1
        sh.Range("A2:C" & eRow).Copy shKQ.Range("A" & eRowKQ + 1)
      End If
    End If
  Next sh
End Sub
 
Tạo Sheet mới đặt tên là "TongHop"
Mã:
Option Compare Text
Sub MergeSheets()
  Dim shKQ As Worksheet, sh As Worksheet
  Dim eRow As Long, eRowKQ As Long

  Set shKQ = Sheets("TongHop")
  For Each sh In ThisWorkbook.Sheets
    If sh.Name Like "Máy?*" Then
      eRow = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
      If eRow > 2 Then
        eRowKQ = shKQ.Range("A" & Rows.Count).End(xlUp).Row + 1
        sh.Range("A2:C" & eRow).Copy shKQ.Range("A" & eRowKQ + 1)
      End If
    End If
  Next sh
End Sub
Dạ em cảm ơn bác nhiều nhé. chúc bác năm mới vui vẻ, hehehe.
 
Web KT
Back
Top Bottom