[[20190309194448]]　『ファイルを別名で保存（ループ）』（ねぎ）　ページの最後に飛ぶ

『ファイルを別名で保存（ループ）』（ねぎ）

現在、あるシート（sh1）から所定の様式（sh2）に値を転記し、別名で保存するマクロを作成しようと思っているのですがうまくいきません。

■具体処理
sh1のD,C,E,Nの列の10行目以降の値をsh2のE2,S1,Q2,Y1に転記し別名で保存する。sh1の１行ごとに１ファイル生成するイメージです。
ファイル名は転記後のsh2のS1の値＋アンダーバー＋sh2のY1の値というイメージです。

■フォルダ構成
sh1があるブック、様式格納フォルダ、様式保存場所フォルダという構成で、
様式格納フォルダにある様式1.xlsxに転記し、様式保存場所フォルダに名前を付けて保存するイメージです。

以下コードの

 Set wb = Workbooks.Open(fpath & fname, UpdateLinks:=0)
でデバッグが示されます。

お力を貸していただけないでしょうか。

以上、よろしくお願いします。

ーーーーーーーーーーーーー
以下コードです。

Sub 別名保存()
Dim fpath As String, fname As String

 Dim wb As Workbook
 Dim sh1 As Worksheet, sh2 As Worksheet
 Dim ID As String
 Dim Sname As String

FN = Range("C2")

 Application.ScreenUpdating = False

 Set sh1 = ThisWorkbook.Worksheets("01_北海道")
 i = 10
 fpath = ThisWorkbook.Path & "\様式\"
 fname = Dir(fpath & "様式1.xlsx", vbNormal)
 Do

 Set wb = Workbooks.Open(fpath & fname, UpdateLinks:=0)

 Set sh2 = wb.Worksheets(1)
 i = i + 1

 With sh2
 .Range("E2").Value = sh1.Range("D" & i).Value
 .Range("S1").Value = sh1.Range("C" & i).Value
 .Range("Q2").Value = sh1.Range("E" & i).Value
 .Range("Y1").Value = sh1.Range("N" & i).Value

 End With

 ID = sh2.Range("S1").Value
 Sname = sh2.Range("Y1").Value

wb.SaveAs Filename:=ID & "_" & Sname & ".xlsx"

 fname = Dir()
 Loop
 Application.ScreenUpdating = True

End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

＜使用 Excel：unknown、使用 OS：unknown ＞

記載忘れです。
sh1のD,C,E,Nの列の10行目からC列の値が終わるまで処理をループさせたいです。
（ねぎ） 2019/03/09(土) 19:58

様式1.xlsxは最初に１回開くだけでよいのでは？

（マナ） 2019/03/09(土) 20:40

マナ様

ご回答ありがとうございます。
様式1.xlsxは最初に１回開くだけで良いとのことですが、
１回開いて、値を転記、名前をつけて保存の繰り返しで良いですね。

Set wb = Workbooks.Open(fpath & fname, UpdateLinks:=0)を
doの上に持ってくるイメージですかね？
（ねぎ） 2019/03/11(月) 10:30

＞doの上に持ってくるイメージですかね？

はい。どせなら、↓も

＞Set sh2 = wb.Worksheets(1)

'---

あと、エラーと関係ないですが
保存するときは、フルパスで。

（マナ） 2019/03/11(月) 20:13

コメント返信：

[ 一覧(最新更新順) ]

[[20190309194448]] 『ファイルを別名で保存（ループ）』（ねぎ） ページの最後に飛ぶ

[[20190309194448]]　『ファイルを別名で保存（ループ）』（ねぎ）　ページの最後に飛ぶ