Code tổng hợp dữ liệu sang một sheet

[khoa_pr]

Chào các bạn


Nhờ các bạn xem và chỉnh giúp code VBA:
1- Khi nhấn nút "Cập nhật DS_CNTN" thì bỏ qua các sheet "Trangchu, Dien1,Dien2,Dien3a,Dien3b,Dien3c", chỉ copy dữ liệu các sheet "Congnhandien1,congnhandien2,congnhandien3a,congnhandien3b, congnhandien3c" từ Row 10 trở xuống. Dòng trống không copy, sheet chưa có dữ liệu (Congnhandien3c) không copy .
2- Nhưng đoạn code của tôi nó copy lặp lại dữ liệu, nếu "Congnhandien3c" chưa có dữ liệu nó lại copy Row 9.
3- Code như sau :
Public Const ExceptSheetName =_ "Trangchu*Dien1*Dien2*Dien3a*Dien3b*Dien3c*"

Sub CopNoi()
Dim Sh As Byte, i As Byte
Dim ri As Long, R As Long
Sheet9.Range("B2:M600").ClearContents
For Sh = 1 To Worksheets.Count
If InStr(1, ExceptSheetName, Worksheets(Sh).Name & "*") <= 0 Then
ri = Sheets(Sh).[C520].End(xlUp).Row
Sheets(Sh).Range("B10:M" & ri).Copy
R = Sheet9.[C600].End(xlUp).Row + 1
Sheet9.Range("B" & R).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next
[B2].Select
End Sub

 

[SA_DQ]

Bạn thử thay bằng macro này xem sao:

Sub CopyNoi_()
 Dim Sh As Worksheet, Rws As Long
 Const ShName As String = "Congnhandien"
 
 Sheets("TonghopCongnhan").Select       '*'
 Rows("1:520").Hidden = False
 Range("B2:M520").ClearContents
 For Each Sh In ThisWorkbook.Worksheets
    If InStr(Sh.Name, ShName) Then
        Rws = Sh.[B9].End(xlDown).Row
        If Rws < 520 Then _
            Sh.[b10].Resize(Rws, 13).Copy Destination:=[B520].End(xlUp).Offset(1)
    End If
 Next Sh
 Rws = [B2].CurrentRegion.Rows.Count
 Rows(Rws & ":520").Hidden = True
End Sub

 

[khoa_pr]

Chào SA_DQ
Cám ơn bạn, code chạy tốt.
Tuy nhiên minh muốn sau khicopy từ các Sheet Congnhandien, khi paste qua TonghopCongnhan chi PasteValue,dung Paste tất cả định dạng. Như vậy đoạn code “Sh.[b10].Resize(Rws, 13).Copy Destination:=[B520].End(xlUp).Offset(1)”minh sửa lại thế nào hả bạn.