[حل شده] راهنمایی در ذخیره سازی

[kazem1359]

سلام
در کد زیر چطور میشه فایل در مسیری کپی بشه که فایل اصلی وجود داره یعنی به جای کد strSavePath = "d:" چه کدی باشه که فایل کپی شده در مسیر فایل اصلی ساخته بشه؟
ممنون

Sub CreateWorkbooks()
Dim wb As Workbook
Dim wbs As Workbook
Dim sht As Object
Dim strSavePath As String
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
strSavePath = "d:\"
Set wbs = ActiveWorkbook
For Each sht In wbs.Sheets
Sheet1.Copy
Set wb = ActiveWorkbook
wb.SaveAs strSavePath & sht.Name
wb.Close

Exit Sub

Next
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "Failed. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub 

[iranweld]

با سلام
این کد را جایگزین کنید

strsavepath=ActiveWorkbook.path &"\"