Copy nhiều sheet từ 1 file excel sang 1 file excel khác

[hic1802]

Chào mọi người trên GPE,
Tôi có tìm kiếm được trên diễn đàn mình code VBA copy 1 sheet từ 1 file excel này sang 1 file excel mới ( và có đặt tên cho file excel mới theo điều kiện), bây giờ tôi muốn copy nhiều hơn 1 sheet thì phải làm như thế nào được nhỉ? Nhờ mọi người giúp đỡ (mọi người xem hình ảnh tôi gửi kèm)
code VBA (đã được điều chỉnh, không phải nguyên gốc)

Public Sub luu()
Dim Pth As String, fso As Object, Ws As Worksheet, Rng As Range
Set Ws = ThisWorkbook.Sheets("DuLieu")
Pth = ThisWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Not fso.FolderExists(Pth & "\DuLieuSau") Then fso.CreateFolder (Pth & "\DuLieuSau")
    Ws.Range("A1").CurrentRegion.Copy
    With Workbooks.Add
        With .Sheets(1)
            .Name = "DuLieu"
            .Range("A1").PasteSpecial 8
            .Range("A1").PasteSpecial xlPasteValues
            .Range("A1").PasteSpecial xlPasteFormats
        End With
            .Close True, Pth & "\DuLieuSau\BC_" & Format(Ws.Range("A4"), "dd_mm") & ".xlsx"
    End With
MsgBox "Luu xong!"
Set fso = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

 

[snow25]

Chào mọi người trên GPE,
Tôi có tìm kiếm được trên diễn đàn mình code VBA copy 1 sheet từ 1 file excel này sang 1 file excel mới ( và có đặt tên cho file excel mới theo điều kiện), bây giờ tôi muốn copy nhiều hơn 1 sheet thì phải làm như thế nào được nhỉ? Nhờ mọi người giúp đỡ (mọi người xem hình ảnh tôi gửi kèm)
code VBA (đã được điều chỉnh, không phải nguyên gốc)

Public Sub luu()
Dim Pth As String, fso As Object, Ws As Worksheet, Rng As Range
Set Ws = ThisWorkbook.Sheets("DuLieu")
Pth = ThisWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Not fso.FolderExists(Pth & "\DuLieuSau") Then fso.CreateFolder (Pth & "\DuLieuSau")
    Ws.Range("A1").CurrentRegion.Copy
    With Workbooks.Add
        With .Sheets(1)
            .Name = "DuLieu"
            .Range("A1").PasteSpecial 8
            .Range("A1").PasteSpecial xlPasteValues
            .Range("A1").PasteSpecial xlPasteFormats
        End With
            .Close True, Pth & "\DuLieuSau\BC_" & Format(Ws.Range("A4"), "dd_mm") & ".xlsx"
    End With
MsgBox "Luu xong!"
Set fso = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

Thử.

Public Sub luu()
Dim Pth As String, fso As Object, Ws As Worksheet, Rng As Range
Pth = ThisWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Not fso.FolderExists(Pth & "\DuLieuSau") Then fso.CreateFolder (Pth & "\DuLieuSau")
             Sheets(Array("matrang", "bangoc")).Copy
             ActiveWorkbook.SaveAs Pth & "\DuLieuSau\BC_" & Format(Ws.Range("A4"), "dd_mm") & ".xlsx"
MsgBox "Luu xong!"
Set fso = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

 

[hic1802]

Thử.

Public Sub luu()
Dim Pth As String, fso As Object, Ws As Worksheet, Rng As Range
Pth = ThisWorkbook.Path
Set Ws = ThisWorkbook.Sheets("DuLieu")
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Not fso.FolderExists(Pth & "\DuLieuSau") Then fso.CreateFolder (Pth & "\DuLieuSau")
             Sheets(Array("matrang", "bangoc")).Copy
             ActiveWorkbook.SaveAs Pth & "\DuLieuSau\BC_" & Format(Ws.Range("A4"), "dd_mm") & ".xlsx"
MsgBox "Luu xong!"
Set fso = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

Tôi chạy báo lỗi dòng này
ActiveWorkbook.SaveAs Pth & "\DuLieuBaoCao\BC_" & Format(Ws.Range("D2"), "dd_mm") & ".xlsx"
hình như bác chưa khai báo biến Ws
code tôi tùy biến

Public Sub luu()
Dim Pth As String, fso As Object, Ws As Worksheet, Rng As Range
Pth = ThisWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Not fso.FolderExists(Pth & "\DuLieuBaoCao") Then fso.CreateFolder (Pth & "\DuLieuBaoCao")
             Sheets(Array("MaTranCV", "BaoCao")).Copy
             ActiveWorkbook.SaveAs Pth & "\DuLieuBaoCao\BC_" & Format(Ws.Range("D2"), "dd_mm") & ".xlsx"
MsgBox "Luu xong!"
Set fso = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

Xin hỏi là trong file excel tôi lưu có thể bỏ các nút chạy lệnh (sharp) thì làm như thế nào?