Nhờ sửa code Copy nối nhiều sheet

[TrungChinhs]

Chào các bạn ! mình đã xem trên GPE một số Sub Copy nối dữ liệu từ nhiều Sheet vào 1 sheet (TongHop) nhưng khi áp dụng thì có một vấn đề phát sinh là trong Workbook có 1 số Sheet phải loại trừ (vd: sheet DonGia hoặc sheet DinhMuc không copy vào sheet TongHop) và một số sheet phát sinh phải tổng hợp vậy phải sửa code như thế nào ?

Dữ liệu và code trong file đính kèm. Nhờ các bạn sửa giúp. Xin cảm ơn !

 

[rollover79]

Đây là code của bạn đang sử dụng

Sub CopNoiSheet()
    Dim Sh As Byte, i As Byte
    Dim ri As Long, R As Long
    Sheet1.Range("B4:H65536").ClearContents
    For Sh = 1 To Worksheets.Count - 1
        ri = Sheets(Sh).[C65536].End(xlUp).Row
        Sheets(Sh).Range("B4:H" & ri).Copy
        R = Sheet1.[C65536].End(xlUp).Row + 1
        Sheet1.Range("B" & R).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    Next
    [B4].Select
End Sub

- Vòng For của bạn chạy thế kia thì sẽ thiếu mất 1 Sheet, bạn phải cho chạy đến Worksheets.Count chứ không phải là Worksheets.Count - 1
- Theo như mô tả yêu cầu của bạn thì có thể giải quyết theo cách đơn giản thế này. Dùng tên Sheet để kiểm tra xem Sheet đó có được đưa vào Sheet Tổng hợp hay không. Để tổng quát và dễ sửa code sau này, tôi sẽ dùng 1 hằng định nghĩa tất cả tên của các Sheet không muốn Tổng hợp như sau:

Public Const ExceptSheetName = "DonGia*TongHop*"

Sub CopNoiSheet()
    Dim Sh As Byte, i As Byte
    Dim ri As Long, R As Long
    Sheet1.Range("B4:H65536").ClearContents
    For Sh = 1 To Worksheets.Count
        If InStr(1, ExceptSheetName, Worksheets(Sh).Name & "*") <= 0 Then
            ri = Sheets(Sh).[C65536].End(xlUp).Row
            Sheets(Sh).Range("B4:H" & ri).Copy
            R = Sheet1.[C65536].End(xlUp).Row + 1
            Sheet1.Range("B" & R).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
        End If
    Next
    [B4].Select
End Sub

 

[Po_Pikachu]

Bạn thêm như sau:

[COLOR=#000000][COLOR=#0000bb][FONT=Courier New]Sub CopNoiSheet[/FONT][/COLOR][FONT=Courier New][COLOR=#007700]()[/COLOR][/FONT] [FONT=Courier New][COLOR=#0000bb]Dim Sh [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Byte[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]i [/COLOR][COLOR=#007700]As [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Byte[/COLOR][/FONT] [FONT=Courier New][COLOR=#0000bb]Dim ri [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Long[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]R [/COLOR][COLOR=#007700]As [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Long[/COLOR][/FONT] [FONT=Courier New][COLOR=#0000bb]Sheet1[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#dd0000]"B4:H65536"[/COLOR][COLOR=#007700]).[/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]ClearContents[/COLOR][/FONT] [FONT=Courier New][COLOR=#007700]For [/COLOR][COLOR=#0000bb]Sh [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]1 To Worksheets[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Count [/COLOR][/FONT] [FONT=Courier New][COLOR=red]If Sheets(Sh).Name  "DonGia" And Sheets(Sh).Name  "TongHop" [/COLOR][/FONT][FONT=Courier New][COLOR=red]Then[/COLOR][/FONT] [COLOR=#0000bb][FONT=Courier New]   ri [/FONT][/COLOR][FONT=Courier New][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Sheets[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Sh[/COLOR][COLOR=#007700]).[[/COLOR][COLOR=#0000bb]C65536[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000bb]End[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]xlUp[/COLOR][COLOR=#007700]).[/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Row[/COLOR][/FONT] [FONT=Courier New][COLOR=#0000bb]   Sheets[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Sh[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#dd0000]"B4:H" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000bb]ri[/COLOR][COLOR=#007700]).[/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Copy[/COLOR][/FONT] [FONT=Courier New][COLOR=#0000bb]   R [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Sheet1[/COLOR][COLOR=#007700].[[/COLOR][COLOR=#0000bb]C65536[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000bb]End[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]xlUp[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Row [/COLOR][COLOR=#007700]+ [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]1[/COLOR][/FONT] [FONT=Courier New][COLOR=#0000bb]   Sheet1[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#dd0000]"B" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000bb]R[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]PasteSpecial Paste[/COLOR][COLOR=#007700]:=[/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]xlPasteValues[/COLOR][/FONT] [FONT=Courier New][COLOR=#0000bb]   Application[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]CutCopyMode [/COLOR][COLOR=#007700]= [/COLOR][/FONT][COLOR=#0000bb][FONT=Courier New]False[/FONT][/COLOR] [FONT=Courier New][COLOR=#0000bb][COLOR=red]End [/COLOR][/COLOR][/FONT][COLOR=#007700][FONT=Courier New][COLOR=red]If[/COLOR][/FONT] [/COLOR][FONT=Courier New][COLOR=#0000bb]Next[/COLOR][/FONT] [FONT=Courier New][COLOR=#007700][[/COLOR][COLOR=#0000bb]B4[/COLOR][COLOR=#007700]].[/COLOR][/FONT][COLOR=#0000bb][FONT=Courier New]Select[/FONT][/COLOR] [FONT=Courier New][COLOR=#0000bb]End Sub[/COLOR][/FONT][/COLOR]

Thân.

 

[Po_Pikachu]

Em không biết bác cần gì về việc copy dữ liệu nhưng nếu bác muốn copy giá trị thôi thì không cần dài dòng như thế, chỉ việc chuyển giá trị từ vùng này qua vùng khác là được rồi! Rồi căn cứ theo lần tiếp theo của Sheet để gia tăng thêm chỉ số dòng của nó thôi! Bác xem code nha!

Sub CopNoiSheet1()     Dim Sh As Byte     Sheet1.Range("B4:H65536").ClearContents     j = 4     For Sh = 1 To Worksheets.Count     If Sheets(Sh).Name  "DonGia" And Sheets(Sh).Name  "TongHop" Then         ri = Sheets(Sh).[C65536].End(xlUp).Row - 4         Range("B" & j & ":C" & ri + j).Value = Sheets(Sh).Range("B4:C" & Sheets(Sh).[C65536].End(xlUp).Row).Value         j = j + ri + 1     End If     Next     [B4].Select End Sub

Thân.

 

[TrungChinhs]

@ Po_Pikachu, rollover79 mình đã test code của 2 bạn, kết quả như mong muốn.
Cảm ơn 2 bạn đã giúp đỡ !

Thân

 

[TrungChinhs]

Em không biết bác cần gì về việc copy dữ liệu nhưng nếu bác muốn copy giá trị thôi thì không cần dài dòng như thế, chỉ việc chuyển giá trị từ vùng này qua vùng khác là được rồi!
Rồi căn cứ theo lần tiếp theo của Sheet để gia tăng thêm chỉ số dòng của nó thôi!
Bác xem code nha!

Sub CopNoiSheet1()
    Dim Sh As Byte
    Sheet1.Range("B4:H65536").ClearContents
    j = 4
    For Sh = 2 To Worksheets.Count
    If Sheets(Sh).Name <> "DonGia" And Sheets(Sh).Name <> "TongHop" Then
        ri = Sheets(Sh).[C65536].End(xlUp).Row - 4
        Range("B" & j & ":C" & ri + j).Value = Sheets(Sh).Range("B4:C" & Sheets(Sh).[C65536].End(xlUp).Row).Value
        j = j + ri + 1
    End If
    Next
    [B4].Select
End Sub

Thân.

Đúng là chỉ cần như vậy. Đã test kết quả đúng (nay mới phát hiện nếu trong Workbook có sheet rỗng thì sẽ thiếu 3 dòng của sheet dữ liệu cuối, vì trong ví dụ có sheet... rỗng nên thử không được). Thanks !

 

[rollover79]

If Sheets(Sh).Name <> "DonGia" And Sheets(Sh).Name <> "TongHop" Then

Dòng này đọc lên thấy có vấn đề thì phải???
(Sory, lại nhầm sang trường hợp khác rồi...)