Soru Seçimi Excel'de ayrı bir dosya olarak kaydetme Kodu

[ramazan kuyumcu]

Arkadaşlar bu kod işe yarıyor ancak seçilen alandaki veriler formüllü olduğu için yeni dosyada formül sonuçları görünmüyor yani değer olarak kopyalamıyor. birde dosya ismini günün tarihi olsun istiyorum yardımcı olursanız çok sevinirim.

Sub ExportRangetoExcel()
'Update 20130916
Dim wb As Workbook
Dim saveFile As String
Dim WorkRng As Range
Dim address As String
Dim defult As Integer
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
defult = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Application.Workbooks.Add
Application.SheetsInNewWorkbook = defult
WorkRng.Copy
wb.Worksheets(1).Paste
address = Replace(WorkRng.address, ":", "-")
address = Replace(address, "$", "")
address = Replace(address, ".", "")
saveFile = Application.GetSaveAsFilename(InitialFileName:=address, fileFilter:="Excel Workbooks (*.xlsx),*.xlsx")
wb.SaveAs Filename:=saveFile
wb.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[RBozkurt]

Deneyiniz,

Sub ExportRangetoExcel()
    Dim wb As Workbook
    Dim saveFile As String
    Dim WorkRng As Range
    Dim address As String
    Dim defult As Integer
    Dim currentDate As String

    On Error Resume Next
    xTitleId = "Kaydedilecek Alanı Seçin!"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.address, Type:=8)
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
  
    defult = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set wb = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = defult
  
    WorkRng.Copy
    wb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
  
    currentDate = Format(Date, "yyyy-mm-dd")
    saveFile = "ExportedData_" & currentDate & ".xlsx"
  
    saveFile = Application.GetSaveAsFilename(InitialFileName:=saveFile, fileFilter:="Excel Workbooks (*.xlsx),*.xlsx")
    If saveFile <> "False" Then
        wb.SaveAs Filename:=saveFile
    End If
  
    wb.Close
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[ramazan kuyumcu]

RBozkurt Hocam çok teşekkür ederim elinize sağlık