Gộp nhiều sheets trong excel vào 1 sheet

Liên hệ QC

Limhachung

Thành viên mới
Tham gia
29/5/20
Bài viết
41
Được thích
6
Các bạn ơi, bình thường mình làm là sẽ gộp được hết tất cả các sheet này vào 1 sheet sau khi chạy VBA nhưng lần này mình copy VBA và chạy lại chỉ chạy được có 3 sheet đầu. Các bạn giúp mình với! File mình đính kèm bên dưới nhé các bạn!
 

File đính kèm

  • Bang luong 01.xls
    256 KB · Đọc: 16
Các bạn ơi, bình thường mình làm là sẽ gộp được hết tất cả các sheet này vào 1 sheet sau khi chạy VBA nhưng lần này mình copy VBA và chạy lại chỉ chạy được có 3 sheet đầu. Các bạn giúp mình với! File mình đính kèm bên dưới nhé các bạn!
Thu code này coi
Mã:
Sub Combine()
  Dim Ws As Worksheet, iR&, iR1&
  Sheets("Combined").Range("B10:AF10000").ClearContents
  For Each Ws In Worksheets
    iR = Sheets("Combined").Range("B" & Rows.Count).End(3).Row + 1
    If Ws.Name <> "Combined" Then
        iR1 = Ws.Range("C" & Rows.Count).End(3).Row - 1
        iR1 = Ws.Range("C" & iR1).End(3).Row
        Ws.Range("B10:B" & iR1).Resize(, 31).Copy Sheets("Combined").Range("B" & iR)
    End If
  Next
End Sub
 
Upvote 0
Các bạn ơi, bình thường mình làm là sẽ gộp được hết tất cả các sheet này vào 1 sheet sau khi chạy VBA nhưng lần này mình copy VBA và chạy lại chỉ chạy được có 3 sheet đầu. Các bạn giúp mình với! File mình đính kèm bên dưới nhé các bạn!
Hỏi chị tí, sau khi copy qua rồi, dữ liệu sau khi copy mình có còn dùng thêm việc gì nữa hay không?
 
Upvote 0
Hỏi chị tí, sau khi copy qua rồi, dữ liệu sau khi copy mình có còn dùng thêm việc gì nữa hay không?
E tổng hợp lên để tính thu nhập trung bình năm anh ạ
Bài đã được tự động gộp:

Thu code này coi
Mã:
Sub Combine()
  Dim Ws As Worksheet, iR&, iR1&
  Sheets("Combined").Range("B10:AF10000").ClearContents
  For Each Ws In Worksheets
    iR = Sheets("Combined").Range("B" & Rows.Count).End(3).Row + 1
    If Ws.Name <> "Combined" Then
        iR1 = Ws.Range("C" & Rows.Count).End(3).Row - 1
        iR1 = Ws.Range("C" & iR1).End(3).Row
        Ws.Range("B10:B" & iR1).Resize(, 31).Copy Sheets("Combined").Range("B" & iR)
    End If
  Next
End Sub
Cảm ơn bạn, để mình thử xem sao
Bài đã được tự động gộp:

Thu code này coi
Mã:
Sub Combine()
  Dim Ws As Worksheet, iR&, iR1&
  Sheets("Combined").Range("B10:AF10000").ClearContents
  For Each Ws In Worksheets
    iR = Sheets("Combined").Range("B" & Rows.Count).End(3).Row + 1
    If Ws.Name <> "Combined" Then
        iR1 = Ws.Range("C" & Rows.Count).End(3).Row - 1
        iR1 = Ws.Range("C" & iR1).End(3).Row
        Ws.Range("B10:B" & iR1).Resize(, 31).Copy Sheets("Combined").Range("B" & iR)
    End If
  Next
End Sub
Mình không chạy được bạn ạ nó cứ báo lỗi
 
Lần chỉnh sửa cuối:
Upvote 0
Có ai giúp mình gộp sheet hoặc nhiều file excel vào được không?
 
Upvote 0
Các bạn ơi, bình thường mình làm là sẽ gộp được hết tất cả các sheet này vào 1 sheet sau khi chạy VBA nhưng lần này mình copy VBA và chạy lại chỉ chạy được có 3 sheet đầu. Các bạn giúp mình với! File mình đính kèm bên dưới nhé các bạn!
Chạy code . . .
Mã:
Sub ABC()
  Dim Ws As Worksheet, eR&, eRow&
 
  Application.ScreenUpdating = False
  Sheets("Combined").UsedRange.Clear
  For Each Ws In Worksheets
    If Ws.Name <> "Combined" Then
      eR = Sheets("Combined").Range("B" & Rows.Count).End(xlUp).Row
      If eR > 1 Then eR = eR + 2
      eRow = Ws.Range("H" & Rows.Count).End(xlUp).Row
      Ws.Range("A2:AF" & eRow).Copy Sheets("Combined").Range("A" & eR)
    End If
  Next
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Chạy code . . .
Mã:
Sub ABC()
  Dim Ws As Worksheet, eR&, eRow&
 
  Application.ScreenUpdating = False
  Sheets("Combined").UsedRange.Clear
  For Each Ws In Worksheets
    If Ws.Name <> "Combined" Then
      eR = Sheets("Combined").Range("B" & Rows.Count).End(xlUp).Row
      If eR > 1 Then eR = eR + 2
      eRow = Ws.Range("H" & Rows.Count).End(xlUp).Row
      Ws.Range("A2:AF" & eRow).Copy Sheets("Combined").Range("A" & eR)
    End If
  Next
  Application.ScreenUpdating = True
End Sub
Mình chạy mà báo lỗi như này là làm sao bạn ơi? Bạn giúp mình gộp với
 

File đính kèm

  • z3107850991013_846180aa60e1d725a08c15a4b5af74fd.jpg
    z3107850991013_846180aa60e1d725a08c15a4b5af74fd.jpg
    17.4 KB · Đọc: 8
Upvote 0
Mình chạy mà báo lỗi như này là làm sao bạn ơi? Bạn giúp mình gộp với
Đảm bảo hết lỗi
Mã:
Sub ABC()
  Dim Ws As Worksheet, eR&, eRow&
 
  On Error Resume Next
  Application.ScreenUpdating = False
  Sheets("Combined").UsedRange.Clear
  For Each Ws In Worksheets
    If Ws.Name <> "Combined" Then
      eR = Sheets("Combined").Range("B" & Rows.Count).End(xlUp).Row
      If eR > 1 Then eR = eR + 2
      eRow = Ws.Range("H" & Rows.Count).End(xlUp).Row
      Ws.Range("A2:AF" & eRow).Copy Sheets("Combined").Range("A" & eR)
    End If
  Next
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Đảm bảo hết lỗi
Mã:
Sub ABC()
  Dim Ws As Worksheet, eR&, eRow&
 
  On Error Resume Next
  Application.ScreenUpdating = False
  Sheets("Combined").UsedRange.Clear
  For Each Ws In Worksheets
    If Ws.Name <> "Combined" Then
      eR = Sheets("Combined").Range("B" & Rows.Count).End(xlUp).Rowachs thứ hai
      If eR > 1 Then eR = eR + 2
      eRow = Ws.Range("H" & Rows.Count).End(xlUp).Row
      Ws.Range("A2:AF" & eRow).Copy Sheets("Combined").Range("A" & eR)
    End If
  Next
  Application.ScreenUpdating = True
End Sub
Bạn nhắc tới cái tên "Combined" những 4 lần. Theo nguyên tắc "magic numbers" thì điều này nên tránh.
Giải quyết bằng cách Set hẳn cái sheet chủ yếu vào một biến

Dim shCB As WorkSheet
Set shCB = WorkSheets("Combined")
shCB.UsedRange.Clear
For Each Ws In Worksheets
If Not (Ws Is shCB) Then
eR = shCB.Range("B" & Rows.Count).End(xlUp).Row
If eR > 1 Then eR = eR + 2
eRow = Ws.Range("H" & Rows.Count).End(xlUp).Row
Ws.Range("A2:AF" & eRow).Copy shCB.Range("A" & eR)
End If
Next

Cách thứ hai, dùng With block (tôi không chuộng cách này vì rất dễ bị nhầm lẫn và khó copy/paste code)

With WorkSheets("Combined")
.UsedRange.Clear
For Each Ws In Worksheets
If Ws.Name <> .Name Then
eR = .Range("B" & Rows.Count).End(xlUp).Row
If eR > 1 Then eR = eR + 2
eRow = Ws.Range("H" & Rows.Count).End(xlUp).Row
Ws.Range("A2:AF" & eRow).Copy .Range("A" & eR)
End If
Next
End With
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom