Xuất dữ liệu excel sang file excel mới

[kdhiaenuh]

Các anh chị chỉ giúp em với ạ.
Hiện tại em đang muốn xuất 1 vùng dữ liệu sang bảng excel mới nhưng em tìm hiểu thì chỉ viết được đoạn code mà tên file và thư mục lưu là cố định.
Giờ em đang muốn khi xuất vùng dữ liệu ra file excel mới thì mình có thể chọn được vùng lưu trữ và nhập tên file mới.
Mong các anh chị chỉ giúp em ạ.
Em xin cảm ơn..!
Đoạn code của em đây ạ.!
Sub Xuatexcel_lamviec()
Dim curPath As String
curPath = ActiveWorkbook.Path & "\Lam Viec "
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("lamviec").Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=curPath & Format(Now(), "hhmm, dd - mm - yyyy") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[be_09]

Các anh chị chỉ giúp em với ạ.
Hiện tại em đang muốn xuất 1 vùng dữ liệu sang bảng excel mới nhưng em tìm hiểu thì chỉ viết được đoạn code mà tên file và thư mục lưu là cố định.
Giờ em đang muốn khi xuất vùng dữ liệu ra file excel mới thì mình có thể chọn được vùng lưu trữ và nhập tên file mới.
Mong các anh chị chỉ giúp em ạ.
Em xin cảm ơn..!

Góp ý cho bạn:
1/ Bạn muốn chọn được 1 vùng thì cần phải hiểu mỗi vùng đó ở đâu, điều kiện nó thế nào, tốt nhất là nên đính kèm File.
2/ Nếu không đính kèm File thì giống như trường hợp trong 1 đơn vị có 4 anh A, bạn gọi tên anh A mà không nêu bộ phận nào thì anh A nào ra làm việc cho bạn.

 

[kdhiaenuh]

Góp ý cho bạn:
1/ Bạn muốn chọn được 1 vùng thì cần phải hiểu mỗi vùng đó ở đâu, điều kiện nó thế nào, tốt nhất là nên đính kèm File.
2/ Nếu không đính kèm File thì giống như trường hợp trong 1 đơn vị có 4 anh A, bạn gọi tên anh A mà không nêu bộ phận nào thì anh A nào ra làm việc cho bạn.

Em vừa gửi file rồi đó ạ. Anh xem giúp em được không ạ

 

[keyeutien]

Các anh chị chỉ giúp em với ạ.
Hiện tại em đang muốn xuất 1 vùng dữ liệu sang bảng excel mới nhưng em tìm hiểu thì chỉ viết được đoạn code mà tên file và thư mục lưu là cố định.
Giờ em đang muốn khi xuất vùng dữ liệu ra file excel mới thì mình có thể chọn được vùng lưu trữ và nhập tên file mới.
Mong các anh chị chỉ giúp em ạ.
Em xin cảm ơn..!
Đoạn code của em đây ạ.!
Sub Xuatexcel_lamviec()
Dim curPath As String
curPath = ActiveWorkbook.Path & "\Lam Viec "
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("lamviec").Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=curPath & Format(Now(), "hhmm, dd - mm - yyyy") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Mình thêm vài bước để chọn folder và nhập tên cho file bạn thử xem dùng được ko
Sub Xuatexcel_lamviec()
Dim curPath As String
Dim sFolder As String
Dim fName As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
sFolder = .SelectedItems(1)
End If
End With
If sFolder <> "" Then
fName = InputBox("Nhap ten file")
curPath = sFolder & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("lamviec").Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=curPath & fName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub

 

[kdhiaenuh]

Mình thêm vài bước để chọn folder và nhập tên cho file bạn thử xem dùng được ko
Sub Xuatexcel_lamviec()
Dim curPath As String
Dim sFolder As String
Dim fName As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
sFolder = .SelectedItems(1)
End If
End With
If sFolder <> "" Then
fName = InputBox("Nhap ten file")
curPath = sFolder & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("lamviec").Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=curPath & fName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub

Em cảm ơn anh, Em làm được rồi ạ