特定場所、ファイル名の変更

質問

以下の様な他の方に組んで頂きました、動作段階でファイルの場所、ファイル名(開く、保存共）を聞いて来ますが、特定場所の特定ファイル名（disktop,ファイル名ABC)にするには、どこを変更すれば宜しいでしょうか？超初心者の為解りません教えて下さい。
Sub Sample()
Dim WB0 As Workbook
Dim WS0 As Worksheet
Dim WB1 As Workbook
Dim WS1 As Worksheet
Dim WB2 As Workbook
Dim WS2 As Worksheet

Dim strFileName As String
Dim dic As Scripting.Dictionary

Dim vntData As Variant
Dim vntResult As Variant
Dim strKey As String
Dim vntRow As Long
Dim dic_i As Long
Dim i As Integer
Dim vntYYYY As Variant

Set WB0 = ThisWorkbook
strFileName = Application.GetOpenFilename("Excelファイル(*.xls),*.xls", , "クロス集計ファイルを選択してください")
If strFileName = "False" Then
MsgBox "ファイル選択がキャンセルされました。処理を中止します"
Exit Sub
End If

Do
vntYYYY = Application.InputBox("集計年度を数字4桁で指定してください", "年度指定", , , , , , 1)
If VarType(vntYYYY) = vbBoolean Then
MsgBox "年度指定がキャンセルされました。処理を中止します"
Exit Sub
End If
If IsNumeric(vntYYYY) And Len(vntYYYY) = 4 Then
Exit Do
Else
MsgBox "年度指定に誤りがあります。再入力してください " & vntYYYY
End If
Loop

'集計元ファイル
Set WB1 = Workbooks.Open(strFileName)
Set WS1 = WB1.Worksheets(1)
'集計先ファイル（新規追加）
Set WB2 = Workbooks.Add(xlWBATWorksheet)
Set WS2 = WB2.Worksheets(1)

'集計元データを配列に取得
vntData = WS1.Range("A1").CurrentRegion.Value

'集計先データの配列を確保（縦・集計元データ数、横・転記列数）
ReDim vntResult(1 To UBound(vntData), 1 To 18)

'Scripting.Dictionaryを生成
Set dic = New Scripting.Dictionary
'データ集計　集計キーはA列
For vntRow = 2 To UBound(vntData, 1)
'集計キーに存在しなかったら、キー追加
strKey = vntData(vntRow, 1)
If Not dic.Exists(strKey) Then
dic_i = dic_i + 1
dic(strKey) = dic_i
'初期値の設定
vntResult(dic_i, 1) = strKey
For i = 2 To 18
vntResult(dic_i, i) = 0
Next
End If
'集計結果を計算
If Val(vntData(vntRow, 2)) = Val(vntYYYY) - 2 Then
vntResult(dic(strKey), 2) = vntResult(dic(strKey), 2) + vntData(vntRow, 3)
End If
If Val(vntData(vntRow, 2)) = Val(vntYYYY) - 1 Then
vntResult(dic(strKey), 3) = vntResult(dic(strKey), 3) + vntData(vntRow, 3)
End If
If Val(vntData(vntRow, 2)) = Val(vntYYYY) Then
For i = 4 To 18
vntResult(dic(strKey), i) = vntResult(dic(strKey), i) + vntData(vntRow, i - 1)
Next
End If
Next
Set dic = Nothing

WB1.Close False
If dic_i > 0 Then
WS2.Range("A1").Resize(, 18).Value = _
Array("客先", Val(vntYYYY) - 2 & "年度", Val(vntYYYY) - 1 & "年度", Val(vntYYYY) & "年度", _
"上期計", "下期計", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月", "1月", "2月", "3月")
WS2.Range("A2").Resize(dic_i, 18).Value = vntResult
MsgBox "集計が完了しました"
Else
WB2.Close False
MsgBox "集計データがありませんでした"
End If
End Sub

回答No.1

n-jun · ベストアンサー

＞WS2.Range("A2").Resize(dic_i, 18).Value = vntResult
ws2.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\ABC.xls"　'←追加
＞MsgBox "集計が完了しました"

と言う事ですか？

補足

有難うございます、早速行ってみます。説明不足がありました、このプログラムではパラメータに入力したDATAに対し、過去3年間出ますが単年度、あるいは複数年度出す為には、どうしらいいですか？追加質問のようで、すみません

回答No.2

n-jun

＃１です。

＞このプログラムではパラメータに入力したDATAに対し、過去3年間出ますが単年度、あるいは複数年度出す為には、どうしらいいですか？
元々どのようなシート構成に対して、どんな結果をもたらすように作られているのかが
不明なので、追加質問の件は私にはわかりません。

もし過去に質問をしていてこのコードが得られたのであれば、そのリンクを貼ってみると
新しい回答がつくかも知れません。

お礼

有難うございました。勉強してみます