[[20200402200750]]　『フォルダー選択機能』（L）　ページの最後に飛ぶ

『フォルダー選択機能』（L）

以下のマクロでファイルの保存先をファイルダイアログで選びたいのですが。どうすればよいのでしょうか。

Sub 出力()
Dim i, s, t, maxR, pno As Long
Dim wb As Workbook
Dim sh1, sh2, sh3 As Worksheet
Dim fpath, fname As String

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.EnableEvents = False

fpath = ThisWorkbook.Path
Set wb = Workbooks.Open(fpath & "\フォーマット集\テンプレート.xlsx", UpdateLinks:=0)

Set sh1 = ThisWorkbook.Sheets("データ")
Set sh2 = wb.Sheets(1)

maxR = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row

For i = 6 To maxR

sh2.Range("A6").Value = sh1.Range("C" & i).Value
sh2.Range("D6").Value = sh1.Range("D" & i).Value
sh2.Range("F6").Value = sh1.Range("E" & i).Value
sh2.Range("K4").Value = sh1.Range("F" & i).Value
sh2.Range("K5").Value = sh1.Range("G" & i).Value
sh2.Range("A9").Value = sh1.Range("H" & i).Value
sh2.Range("D9").Value = sh1.Range("I" & i).Value
sh2.Range("F9").Value = sh1.Range("J" & i).Value
sh2.Range("H9").Value = sh1.Range("K" & i).Value
sh2.Range("I9").Value = sh1.Range("L" & i).Value
sh2.Range("K9").Value = sh1.Range("M" & i).Value
sh2.Range("L9").Value = sh1.Range("N" & i).Value
sh2.Range("G12").Value = sh1.Range("O" & i).Value
sh2.Range("K12").Value = sh1.Range("P" & i).Value
sh2.Range("A29").Value = sh1.Range("BE" & i).Value
sh2.Range("B29").Value = sh1.Range("BF" & i).Value
sh2.Range("C29").Value = sh1.Range("BG" & i).Value
sh2.Range("L5").Value = sh1.Range("BH" & i).Value
sh2.Range("A31").Value = sh1.Range("BI" & i).Value

wb.SaveAs Filename:=ThisWorkbook.Worksheets("データ").Cells(i, 2)
Next i

wb.Close SaveChanges:=True

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
 Application.EnableEvents = True
 MsgBox "終了しました。"
End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 フォルダ ダイアログ 選択 VBA

 でここの過去ログを検索してみてください。
（OK） 2020/04/02(木) 20:11

質問とは関係ないですが、提示のコードは理解してるんでしょうか？
ループ処理をしている意味がないとおもいますが。。

質問自体は既にOKさんからコメントついてますが、
http://officetanaka.net/excel/vba/tips/tips39.htm
↑をみて好きな方法でフォルダパスを取得すればよいでしょう。

そして、　

 wb.SaveAs Filename:=ThisWorkbook.Worksheets("データ").Cells(i, 2)
  ↓
 wb.SaveAs Filename:=[取得したフォルダパス]\[付けたいファイル名]

のようにすればよいと思います。

（もこな２） 2020/04/02(木) 22:10

コメント返信：

[ 一覧(最新更新順) ]

[[20200402200750]] 『フォルダー選択機能』（L） ページの最後に飛ぶ

[[20200402200750]]　『フォルダー選択機能』（L）　ページの最後に飛ぶ