Code lưu file excel theo ngày hiện tại (1 người xem)

[romado]

Các Anh Chị nào cho Em xin đoạn code tự động lưu file excel theo tên của một ô trong sheet.
Ví dụ: tại Sheet 1 Trong ô A1 Em làm công thức lấy ngày, tháng, năm hiện tại "20122017". Em muốn lưu tên file mới trong ổ D với tên tại ô A1.
Em xin cảm ơn cả nhà.

 

[excel_lv1.5]

Các Anh Chị nào cho Em xin đoạn code tự động lưu file excel theo tên của một ô trong sheet.
Ví dụ: tại Sheet 1 Trong ô A1 Em làm công thức lấy ngày, tháng, năm hiện tại "20122017". Em muốn lưu tên file mới trong ổ D với tên tại ô A1.
Em xin cảm ơn cả nhà.

Bạn chạy code này thử xem

Sub wbsave()
Set wb = ThisWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Folder save file"
    .InitialFileName = "d:\"
    If .Show Then wb.SaveAs (.SelectedItems(1) & "\" & wb.Sheets("sheet1").[a1])
End With
End Sub

 

[romado]

Bạn chạy code này thử xem

Sub wbsave()
Set wb = ThisWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Folder save file"
    .InitialFileName = "d:\"
    If .Show Then wb.SaveAs (.SelectedItems(1) & "\" & wb.Sheets("sheet1").[a1])
End With
End Sub

Cảm ơn Pác nhưng Em thử không được Pác ah. nó lại cứ ra hộp thoại bắt phải đánh tên là sao nhỉ?

 

[Hoang2013]

Bạn thử cái ni cho vui:

Sub LuuFile()
 Dim ChDir As String
 If IsDate([a1].Value) Then
    ChDir = "D:\Excel\" & StrDate([a1].Value)          '"
 End If
 ActiveWorkbook.SaveAs FileName:=ChDir, FileFormat:=xlExcel8 _
    , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Function StrDate(Optional Dat As Date) As String
 Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 If Dat < 1 Then Dat = Date
 StrDate = Mid(Alf, Year(Dat) - 2000, 1)
 StrDate = StrDate & Mid(Alf, 1 + Month(Dat), 1) & Mid(Alf, 1 + Day(Dat), 1)
End Function