Lưu File tự động ra Forlder chứa File đang làm việc

[Phương Phương mito]

Kính gửi ANh chị
Em có đoạn code tạo ra một File mới lấy nội dung từ sheet1 tại File tên là "Tao File moi tu sheet Data" trong Folder "Tao File". Làm sao để khi bấm nút sau khi File mới này được tạo ra thi nó Lưu tự động File này vào Forder"Tao File" và đặt tên File này là Tonkho ạ.

 

[Phương Phương mito]

Kính gửi ANh chị
Em có đoạn code tạo ra một File mới lấy nội dung từ sheet1 tại File tên là "Tao File moi tu sheet Data" trong Folder "Tao File". Làm sao để khi bấm nút sau khi File mới này được tạo ra thi nó Lưu tự động File này vào Forder"Tao File" và đặt tên File này là Tonkho ạ.

Anh Chị giúp em với ạ !

 

[Maika8008]

Tạo folder có tên "Tao file" trong đường dẫn của file hiện hành và lưu file với tên là TonKho.xlsx

Sub Tonkho()
Dim DesktopPath1 As String, MyPath As String
Dim fso As Object

    DesktopPath1 = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    MyPath = ThisWorkbook.Path & "\"
    With Application
        .ScreenUpdating = False
        Sheet1.Copy
        ActiveSheet.Name = "Ton kho"
        ActiveSheet.Shapes.Range(Array("Button 1")).Select
        Selection.Delete
        fso.CreateFolder (MyPath & "Tao File\")
        ActiveWorkbook.Close True, MyPath & "Tao File\" & "TonKho.xlsx"
        .ScreenUpdating = True
    End With
End Sub

 

[Phương Phương mito]

Tạo folder có tên "Tao file" trong đường dẫn của file hiện hành và lưu file với tên là TonKho.xlsx

Sub Tonkho()
Dim DesktopPath1 As String, MyPath As String
Dim fso As Object

    DesktopPath1 = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    MyPath = ThisWorkbook.Path & "\"
    With Application
        .ScreenUpdating = False
        Sheet1.Copy
        ActiveSheet.Name = "Ton kho"
        ActiveSheet.Shapes.Range(Array("Button 1")).Select
        Selection.Delete
        fso.CreateFolder (MyPath & "Tao File\")
        ActiveWorkbook.Close True, MyPath & "Tao File\" & "TonKho.xlsx"
        .ScreenUpdating = True
    End With
End Sub

Cho em hỏi thêm chút ạ. Khi chạy nếu bấm lưu từ lần 2 thì excel nó sẽ hiện lên thông báo là File đó đã tồn tại và có lưu lại không gồm (YES,NO, Cancel). giờ có code gì đến nó tích luôn vào nút YES của thông báo không ạ ?

 

[Phuocam]

Cho em hỏi thêm chút ạ. Khi chạy nếu bấm lưu từ lần 2 thì excel nó sẽ hiện lên thông báo là File đó đã tồn tại và có lưu lại không gồm (YES,NO, Cancel). giờ có code gì đến nó tích luôn vào nút YES của thông báo không ạ ?

Thêm một chút:

With Application
        .ScreenUpdating = False
        .DisplayAlerts = False

        ...

        .DisplayAlerts = True
        .ScreenUpdating = True
  End With

 

[Phương Phương mito]

Thêm một chút:

With Application
        .ScreenUpdating = False
        .DisplayAlerts = False

        ...

        .DisplayAlerts = True
        .ScreenUpdating = True
  End With

CHo em hỏi thêm chút ạ. Nếu khi mở File và em ẩn sheet1 (tên là Data) thì toàn bộ code không chạy được ạ. Có cách gì code vẫn chạy khi ẩn sheet1 đi không ạ

 

[Maika8008]

CHo em hỏi thêm chút ạ. Nếu khi mở File và em ẩn sheet1 (tên là Data) thì toàn bộ code không chạy được ạ. Có cách gì code vẫn chạy khi ẩn sheet1 đi không ạ

thêm Sheet1.Visible = xlSheetVisible trước With Application
và Sheet1.Visible = xlSheetHidden sau End With

 

[Nhattanktnn]

CHo em hỏi thêm chút ạ. Nếu khi mở File và em ẩn sheet1 (tên là Data) thì toàn bộ code không chạy được ạ. Có cách gì code vẫn chạy khi ẩn sheet1 đi không ạ

Thử :

Sub Tonkho1()
Dim MyPath As String, Fso As Object, Chk As Boolean
    Set Fso = CreateObject("Scripting.FileSystemObject")
    MyPath = ThisWorkbook.Path & "\"
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .CopyObjectsWithCells = False
        With Sheet1
            Chk = .Visible
            .Visible = xlSheetVisible
            .Copy
            .Visible = Chk
        End With
        ActiveSheet.Name = "Ton kho"
        If Not Fso.folderexists(MyPath & "Tao File\") Then Fso.CreateFolder (MyPath & "Tao File\")
        ActiveWorkbook.Close True, MyPath & "Tao File\" & "TonKho.xlsx"
        .CopyObjectsWithCells = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub