VBA問題,另存到指定位置

請問一下該如何改動才能指定儲存位置呢?


Private Sub CommandButton1_Click()

Dim Arr, k%, i%, j%, m%

For k = 1 To [A65536].End(3).Row Step 25
If j * 25 > [A65536].End(3).Row Then m = 25 - [A65536].End(3).Row Mod 25 Else m = 0
Arr = Intersect(ActiveSheet.UsedRange, Rows(k & ":" & k + 24 - m))
For i = 1 To UBound(Arr)
Arr(i, 1) = Join(Application.Index(Arr, i), ",")
Next
j = j + 1
Open ThisWorkbook.Path & "" & VBA.Format(VBA.Date, "yyyymmdd") _
& Format(j, "000") & ".csv" For Output As #1
Print #1, Join(Application.Transpose(Application.Index(Arr, , 1)), vbCrLf): Reset
Next
End Sub