[Nhờ sửa code] Copy Value nhiều Sheet trong Workbook sang workbook mới. (1 người xem)

[quyenpv]

Nhờ các anh giúp đỡ sửa code copy value nhiều Sheet của workbook này sang workbook khác với điều kiện không copy dòng ẩn và xóa code nếu có trong Sheet copy

Option Explicit


Sub TwoSheetsAndYourOut()
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet
    
    If MsgBox("Ban co muon Copy cac Sheet lua chon sang Workbook moi khong" & vbCr & _
    "New sheets will be pasted as values, named ranges removed" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub


    With Application
        .ScreenUpdating = False
        
'       Copy specific sheets
'       *SET THE SHEET NAMES TO COPY BELOW*
'       Array("Sheet Name", "Another sheet name", "And Another"))
'       Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher
        'Sheets(Array("Copy Me", "Copy Me2")).Copy
        Sheets(Array("Bia", "To Trinh", "Quyet Dinh", "SS", "TDT CD", "THDTXD_CD", "VLC_ACap", "DT")).Copy


        On Error GoTo 0
        
'       Paste sheets as values
'       Remove External Links, Hperlinks and hard-code formulas
'       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select
        
'       Remove named ranges
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next nm
        
'       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
    
'       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
        ActiveWorkbook.Close SaveChanges:=False
      
        .ScreenUpdating = True
    End With
    Exit Sub
    
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub

 

[quyenpv]

Hix có anh chị nào giúp hộ em với ạ

 

[quyenpv]