Code copy sheet và tạo folder mới rồi dán sheet

[namkpac]

Em mở 1 top mới chứ bài viết bên kia không đúng chỗ
Các anh chị giúp em 1 trường hợp này với; em có 1 file excel tên GIAYMOI nằm trong 1 folder tên DICH, bây giờ em muốn copy sheet1 trong file excel GIAYMOI đồng thời tạo 1 folder mới với tên của folder được lấy từ cell A4 của sheet1 và khi copy xong là đưa sheet1 này vào chính folder mới tạo có tên được lấy từ cell A4 của sheet1 đó và tên file mới sau khi copy đó cũng tên được lấy từ cell A4 luôn. thêm điều kiện là nếu có trùng thì báo và lưu mới cũng gồm tên được lấy tại cell A4 và thêm thời gian, ngày tháng năm sau tên đó. Em gửi kèm ví dụ luôn trong đó GIAYMOI là file gốc.

 

[namkpac]

Em cảm ơn rất nhiều, rất đúng với nội dung bài đặt ra. xin cảm ơn mọi người và một lần nữa em xin khẳng định em không phải là belu gì đó đâu.

 

[namkpac]

Chỗ màu đỏ chắc anh nhầm thì phải.

Cái chỗ màu đỏ không bị nhầm đâu ạ, nếu máy anh chị cài office mà không khai báo thư viện thì khi chạy code nó có báo lỗi thiếu thư viện thôi. em cũng từng bị và vào tools\references...\tích chọn microsoft scripting runtime hay là microsoft office scripting runtime x.x type library em cũng ko rõ vì em chọn cả 2 luôn.

 

[Good-Luck]

Nếu nick belukn là của bạn thì mình khuyên bạn không nên làm vậy. Một nick vừa tạo chỉ để post 1 bài, bác ndu là smod có thể scan IP để xem 2 nick có chung 1 IP hay không.
Trở lại vấn đề của bạn, mấy cái code save file vào folder thì mình làm được nhưng nếu tiếng Việt có dấu thì mình chịu.

Nếu là tiếng việt có dấu thì dùng FileSystemObject

đường link : tại đây

 

[Hau151978]

Nếu là tiếng việt có dấu thì dùng FileSystemObject

đường link : tại đây

FileSystemObject thì mình biết rồi và đã làm ở bài 53, 55; mình hỏi vì thấy bài trả lời 23 của dhn46 có nhắc đến hàm tiếng Việt. Mà cũng không hiểu tác giả còn yêu cầu thêm gì nữa?

 

[namkpac]

FileSystemObject thì mình biết rồi và đã làm ở bài 53, 55; mình hỏi vì thấy bài trả lời 23 của dhn46 có nhắc đến hàm tiếng Việt. Mà cũng không hiểu tác giả còn yêu cầu thêm gì nữa?

Anh (chị) cho em hỏi thêm tý nữa được không ạ? với bài trên là copy sheet hiện tại là sheet1 được lấy tên là các ký tự ở cell A4. giờ nếu muốn copy thêm 1 sheet nữa ví dụ là copy thêm sheet3 với tên được lấy cũng tại cell A4 và cũng là hình thành 1 file khác cũng với tên file lấy từ cell A4 và cũng có thời gian phía sau lưu cùng 1 folder đuợc tạo từ ban đầu thì thêm code thế nào ạ? hoặc là copy sheet1 và sheet3 đó vào cùng 1folder với tên file được lấy là cell A4 và cũng có thời gian phía sau

 

[namkpac]

A Hau151978 có thể coi giúp e xíu nữa với e ko biết khi copy 2 sheet thì thêm code thế nào.

 

[Hau151978]

A Hau151978 có thể coi giúp e xíu nữa với e ko biết khi copy 2 sheet thì thêm code thế nào.

Bạn sửa lại sub Main():
Sub Main()
Dim FolderPath$, FolderName$, FilePath$, FileName$,i&
Application.ScreenUpdating = False
Set fso = New FileSystemObject
FolderPath = ThisWorkbook.Path
For i=1 to 2
If i=1 then sheet1.activate else sheet3.activate
FolderName = Cells(4, 1).Text
If Not TaoFolder(FolderPath, FolderName) Then MsgBox "Folder existed!"
FilePath = FolderPath & "\" & FolderName
FileName = FolderName & Format(Now, "hh-mm-ss dd-mm-yyyy")
If Not SaveWorkbook(FilePath, FileName) Then MsgBox "File existed!"
Next
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

 

[namkpac]

Bạn sửa lại sub Main():
Sub Main()
Dim FolderPath$, FolderName$, FilePath$, FileName$,i&
End Sub

Anh ơi nó báo lỗi run-time erro ‘1004’
The file could not be accessed. Try one….
· Make sure the specified folder exists.
· Make sure the folder that….
Em chạy Debug thì nó chỉ tới dòng lệnh Workbooks(Workbooks.Count).SaveAs FullFileName trong Function SaveWorkbook
Vậy là sao anh nhỉ

 

[namkpac]

Em xin lỗi cái này là do em chưa đọc hết, do cell A4 của sheet3 chưa có dữ liệu nên chưa copy ra được. tuy nhiên em muốn là gom 2 sheet này vô 1 workbook và cùng chung 1 folder thôi chứ không tách ra làm 2 folder và 2 file nằm ở 2 folder đó.

 

[Hau151978]

Em xin lỗi cái này là do em chưa đọc hết, do cell A4 của sheet3 chưa có dữ liệu nên chưa copy ra được. tuy nhiên em muốn là gom 2 sheet này vô 1 workbook và cùng chung 1 folder thôi chứ không tách ra làm 2 folder và 2 file nằm ở 2 folder đó.

Trường hợp cell A4 trống thì mình sửa được nhưng ở đây có phải bạn muốn copy sheet1 và sheet3 vào chung 1 file không? Vậy đặt tên file và folder thế nào, hay là dựa theo A4 của sheet1?

 

[namkpac]

Trường hợp cell A4 trống thì mình sửa được nhưng ở đây có phải bạn muốn copy sheet1 và sheet3 vào chung 1 file không? Vậy đặt tên file và folder thế nào, hay là dựa theo A4 của sheet1?

đúng rồi ạ, mình copy sheet1 v à sheet3 nhưng tên file và folder đều dựa theo A4 của sheet1

 

[namkpac]

đúng rồi ạ, mình copy sheet1 v à sheet3 nhưng tên file và folder đều dựa theo A4 của sheet1

anh xem lại giúp em với, tên file lấy theo A4 của sheet1 còn lưu file thì copy 2 sheet 1 và 3

 

[namkpac]

Trường hợp cell A4 trống thì mình sửa được nhưng ở đây có phải bạn muốn copy sheet1 và sheet3 vào chung 1 file không? Vậy đặt tên file và folder thế nào, hay là dựa theo A4 của sheet1?

A xem giúp e sửa code copy sheet1,3 vào cùng 1 file và lấy tên file la cell a4 của sheet1 và lưu 1 folder thôi ạ khi cell a4 thay đổi thì lưu tên mới đúng như bài #71 đó a

 

[Hau151978]

Hàng miễn phí bao giờ cũng chậm, bạn chịu trả giá xuống còn thẻ 50k cho ai đó thì chắc xong lâu rồi!

Option Explicit
Private fso As FileSystemObject
Function TaoFolder(ByVal FolderPath$, ByVal FolderName$) As Boolean
    Dim Path$
    Path = FolderPath & "\" & FolderName
    If Not fso.FolderExists(Path) Then
        fso.CreateFolder (Path)
        TaoFolder = True
    End If
End Function
Function SaveWorkbook(ByVal FilePath$, ByVal FileName$) As Boolean
    Dim FullFileName$, Wb As Workbook
    FullFileName = FilePath & "\" & FileName & ".xlsx"
    If Not fso.FileExists(FullFileName) Then
        ThisWorkbook.Sheets("sheet1").Copy
        Set Wb = Workbooks(Workbooks.Count)
        ThisWorkbook.Sheets("sheet3").Copy after:=Wb.Sheets("sheet1")
        Wb.SaveAs FullFileName
        Wb.Close True
        SaveWorkbook = True
        
    End If
End Function
Sub Main()
    Dim FolderPath$, FolderName$, FilePath$, FileName$
    Application.ScreenUpdating = False
    Set fso = New FileSystemObject
    Sheet1.Activate
    FolderPath = ThisWorkbook.Path
    FolderName = Cells(4, 1).Text
    If Not TaoFolder(FolderPath, FolderName) Then MsgBox "Folder existed!"
    FilePath = FolderPath & "\" & FolderName
    FileName = FolderName & Format(Now, "hh-mm-ss dd-mm-yyyy")
    If Not SaveWorkbook(FilePath, FileName) Then MsgBox "File existed!"
    FileName = Sheet3.Cells(4, 1).Text & Format(Now, "hh-mm-ss dd-mm-yyyy")
    If Not SaveWorkbook(FilePath, FileName) Then MsgBox "File existed!"
    Set fso = Nothing
    Application.ScreenUpdating = True
End Sub