Bạn xài tạm code này cho sheet Tonghop nhé:
Private Sub Worksheet_Activate()
Dim i As Byte
Application.ScreenUpdating = False
Me.Move before:=Sheets(1)
[3:10000].Delete
For i = 2 To Sheets.Count
Sheets(i).[3:1000].Copy [A65536].End(xlUp).Offset(1)
Next
Application.ScreenUpdating = True
End Sub
Bạn sửa số 1000 trong code trên thành số lớn hơn là được.
Bạn sử dụng code này thay cho code trên nhé:
Private Sub Worksheet_Activate()
Dim Ws As Worksheet
Application.ScreenUpdating = False
[3:65536].Delete
For Each Ws In ThisWorkbook.Worksheets
If InStr(".A.C.", "." & Ws.Name & ".") > 0 Then
With Ws.Range("A3:P" & Ws.[A65536].End(xlUp).Row)
[A65536].End(xlUp).Offset(1).Resize(.Rows.Count, 16).Value = .Value
End With
End If
Next
Application.ScreenUpdating = True
End Sub
Câu trả lời nằm tại bài #7 đó bạn.
If InStr(".A.C.", "." & Ws.Name & ".") > 0 ThenIf Ws.Name <> "Luong" ThenOk, nhưng mình còn 1 thắc măc nưa anh Phúc ơi.
Bạn thử nghiệm 2 dạng câu lệnh: Nguồn.Copy Đích và Đích.Value=Nguồn.Value, bạn sẽ thấy: Với câu lệnh 1 thì ở Nguồn có định dạng ra sao thì Đích sẽ có định dạng giống như vậy, còn câu lệnh thứ 2 chỉ copy giá trị từ Nguồn tới Đích mà không làm thay đổi định dạng của Đích. Bạn chỉ cần vận dụng linh hoạt 2 dạng câu lệnh trên là được.
Private Sub Worksheet_Activate()
Dim Ws As Worksheet
Dim i As Byte
Application.ScreenUpdating = False
[3:65536].Delete
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Luong" Then
[COLOR=#ff0000] For i = 2 To Sheets.Count[/COLOR]
[COLOR=#ff0000] Sheets(i).[3:1000].Copy [A65536].End(xlUp).Offset(1)[/COLOR]
Next
End If
Next
Application.ScreenUpdating = True
End SubTrời đất, đã For Each Ws In ThisWorkbook.Worksheets rồi còn For i = 2 To Sheets.Count nữa thì nó trùng là đúng rồi chứ sao nữa. Bạn bỏ vòng For thứ 2 đi nhé.
Nguyên nhân là các sheet thành phần của bạn không đồng bộ. Sheet thì nhập từ hàng 2, sheet thì nhập từ hàng 3. Với những bài toán tổng hợp từ nhiều sheet hoặc nhiều file thì cấu trúc file/bảng và quy ước nhập phải được thống nhất và đồng bộ, ngược lại thì việc tổng hợp sẽ khó và dễ sai sót.
Với dữ liệu hiện có trong file thì bạn dùng code này nhé:
Private Sub Worksheet_Activate()
Dim i As Long, fR As Long, lR As Long, Rws As Long
Application.ScreenUpdating = False
[2:65000].Delete 'Xoa du lieu hien co
Sheets(Array("TONGHOP", "Ref")).Move Before:=Sheets(1) 'Di chuyen sheet len dau
For i = 3 To Sheets.Count 'Lam viec voi sheet thu 3 tro di (tru sheet TONGHOP va Ref)
lR = Sheets(i).[A65000].End(xlUp).Row 'Xac dinh dong cuoi chua du lieu
If lR > 1 Then 'Neu co du lieu thi thuc hien
fR = 2 'Xac dinh dong dau cua sheet i
Do While Sheets(i).Cells(fR, 1) = ""
fR = fR + 1 'Xac dinh dong dau chua du lieu cua sheet i
Loop
Rws = lR - fR + 1 'So dong du lieu cua sheet i
[A65000].End(xlUp).Offset(1).Resize(Rws, 18).Value = Sheets(i).Cells(fR, 1).Resize(Rws, 18).Value 'Copy gia tri qua sheet TONGHOP
End If
Next
ActiveSheet.ListObjects("TongHop").Resize Range("A1:R" & [A65000].End(xlUp).Row) 'Mo rong Table TongHop
Application.ScreenUpdating = True
End Sub
Cái này đâu liên quan đến tiêu đề "Tổng hợp nhiều sheet ..."
dạ, thì ví dụ ở sheet em cần tổng hợp vào, em có 1 bảng thống kê chẳng hạn từ ô V2:Z10 ạ, nếu xóa "[2:65000].Delete " thì em sẽ bị mất bảng thống kê đó.
Dùng bộ thu Macro để lấy lệnh
cảm ơn anh, em cũng đã dùng, chọn từ A2:S65000.ClearContents hay .Delele ... nhưng khi copy thì đều bị copy dòng không có giá trị.
Cảm ơn anh, nhưng vẫn bị lỗi copy nhiều lần và chèn ô trống phía trên.
cái này nó xóa luôn cột từ A đến S luôn ạ
(
Bạn sử dòng cũ thành : [A2:R65000].ClearContents 'Xoa du lieu hien co
cảm ơn anh, em cũng đã thử cách này, và nó lại bị lỗi copy dòng trống này ạ.
Excel dùng table khó sử dụng lại nặng file
Private Sub Worksheet_Activate()
Dim i As Long, fR As Long, lR As Long, Rws As Long
Application.ScreenUpdating = False
ActiveSheet.ListObjects("TongHop").Resize Range("$A$1:$R$2")
lR = [A65000].End(xlUp).Row
If lR > 1 Then Range("A2:R" & lR).ClearContents
Sheets(Array("TONGHOP", "Ref")).Move Before:=Sheets(1) 'Di chuyen sheet len dau
For k = 3 To Sheets.Count 'Lam viec voi sheet thu 3 tro di (tru sheet TONGHOP va Ref)
With Sheets(k)
lR = .[A65000].End(xlUp).Row
If lR > 1 Then 'Neu co du lieu thi thuc hien
fR = 0
For i = 2 To lR + 1
If Len(.Cells(i, 1).Value) Then fR = i: Exit For
Next i
If fR > 1 Then
For i = fR + 1 To lR + 1
If Len(.Cells(i, 1).Value) = 0 Then lR = i - 1: Exit For
Next i
i = [A65000].End(xlUp).Row
If Len(Cells(i, 1)) Then i = i + 1
Range("A" & i).Resize(lR - fR + 1, 18).Value = .Range("A" & fR & ":R" & lR).Value 'Copy gia tri qua sheet TONGHOP
End If
End If
End With
Next k
ActiveSheet.ListObjects("TongHop").Resize Range("A1:R" & [A65000].End(xlUp).Row) 'Mo rong Table TongHop
Application.ScreenUpdating = True
End Subđược rồi ạ, em cảm ơn anh nhiều, mới gia nhập bộ môn VBA nên còn nhiều cái bỡ ngỡ quá.
Anh Phúc cho em hỏi chút với code này em đã tổng hợp được, tuy nhiên em chỉ muốn lấy giá trị sang mà không lấy công thức thì có cách nào không ak. Em cảm ơn!
Bạn thêm dòng dưới đây vào Sheets("tonghop")
UsedRange.Value = UsedRange.ValueBạn đính kèm file, nói rõ yêu cầu, tổng hợp cột nào, lấy từ cột nào của những sheet nào...
Nếu không có yêu cầu gì đặc biệt thì dùng lọc, rồi copy và paste. Vba làm gì cho mệt ra.
Mệt ai?
Cả hai chứ bộ anh.
Chỉ mệt ngừoi viết code thôi. Người nhận code chưa biết cái mệt của bảo quản code. Đối với họ, file xlsx và xlsm hoàn toàn không có sự khác biệt. Nếu có sự khác biệt thì ưu thế thiên về bên xlsm.
Anh ơi em đang bắt đầu học, muốn hỏi trong file của anh:
