エクセルVBA ブック間の操作・保存について

質問

エクセルVBAで次の内容でプログラムしたいと思っていますが、どうもうまくいきません。

1.BOOK1のsheet1のセルC10・セルE10に文字入力
2.1のセルE10に文字入力し確定後、BOOK2が自動的に開く
3.BOOK2・sheet1・セルC4にBOOK1・セルC10の文字を取得
4.BOOK2・sheet1・セルH4にBOOK1・セルE10の文字を取得
5.BOOK2に「（秘）セルC10の文字+（セルE10の文字）・ｘｌｓｘ」で名前を付けて保存

6.BOOK1のsheet1のセルC11・セルE11に文字入力
7.6のセルE11に文字入力し確定後、BOOK2が自動的に開く
8.BOOK2・sheet1・セルC4にBOOK1・セルC11の文字を取得
9.BOOK2・sheet1・セルH4にBOOK1・セルE11の文字を取得
10.BOOK2に「（秘）セルC11の文字+（セルE11の文字）.ｘｌｓｘ」で名前を付けて保存
　以降BOOK1　セルC12~C29、セルE12~E29まで上記を繰り返す
　※セルC、Eの文字入力は29行まで入力されないこともある

という感じでBOOK1の決められたセルに入力された文字を
BOOK2へ独立した形で振り分け、それぞれ名前をつけて保存していきたいです。

1～4までは何とかできたのですが、ファイル名をつけて保存と、以降の繰り返しが
いろいろ参考にしたのですが、うまくいきません。

初歩的な内容で申し訳ありませんが、ご教授お願い致します。

回答No.2

ushi2015 · ベストアンサー

No1です。
「BOOK1のそれぞれセルE10～29に文字入力後、マクロが起動するように」
という事は、BOOK1にマクロを設定していいのですか？

BOOK1のSheet1のタブを右クリックしてコードの表示でコードペインを
表示しそこへ
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim bk2 As Workbook
　　Dim r　　 As Range
　　Dim e　　 As Range
　　Const bk2Path As String = "C:\temp\BOOK2.xlsx"

　　If Target.Count > 1 Then Exit Sub
　　Set r = Intersect(Me.Range("C10:C29,E10:E29"), Target)
　　If r Is Nothing Then
　　　　Exit Sub
　　Else
　　　　Set e = Target.EntireRow.Cells(1, 1)
　　　　If e(1, 3) <> "" And e(1, 5) <> "" Then
　　　　　　Application.EnableEvents = False
　　　　　　Application.DisplayAlerts = False
　　　　　　Set bk2 = Workbooks.Open(bk2Path)
　　　　　　bk2.Worksheets("Sheet1").Range("C4").Value = e(1, 3)
　　　　　　bk2.Worksheets("Sheet1").Range("H4").Value = e(1, 5)
　　　　　　bk2.SaveAs _
　　　　　　　　bk2.Path & "\（秘）" & e(1, 3) & _
　　　　　　　　"+（" & e(1, 5) & "）.xlsx", xlWorkbookDefault
　　　　　　bk2.Close
　　　　　　Set bk2 = Nothing
　　　　　　Application.DisplayAlerts = True
　　　　　　Application.EnableEvents = True
　　　　End If
　　End If
End Sub

お礼

解決しました。

迅速な対応でたいへん助かりました。
長々としたコードを考えていたのでさっぱりしました。

また機会がありましたらご教授お願い致します。
ありがとうございました。

回答No.1

ushi2015

こんばんは
C10～C29、E10～E29にはマクロ実行時に文字を入力するのですか？
どこに保存するのですか？
BOOK1、BOOK2は既存ですか？
取り敢えず都度作成して、入力する文字も設定し、"C:\temp\"に保存するとして、
Sub test()
　　Dim bk1 As Workbook
　　Dim bk2 As Workbook
　　Dim i　　 As Long
　　Dim c　　 As Variant
　　Dim e　　 As Variant

　　Const 保存先 As String = "C:\temp\"

　　Set bk1 = Workbooks.Add

　　With bk1.Worksheets("Sheet1")
　　　　For i = 10 To 29
　　　　　　c = Application.InputBox("C" & i & "に入力する文字")
　　　　　　e = Application.InputBox("E" & i & "に入力する文字")
　　　　　　If c <> False Then
　　　　　　　　.Range("C" & i).Value = c
　　　　　　　　.Range("E" & i).Value = e

　　　　　　　　Set bk2 = Workbooks.Add
　　　　　　　　bk2.Worksheets("Sheet1").Range("C4").Value = c
　　　　　　　　bk2.Worksheets("Sheet1").Range("H4").Value = e
　　　　　　　　bk2.SaveAs 保存先 & "（秘）" & c & "+（" & c & "）.xlsx", xlWorkbookNormal
　　　　　　　　bk2.Close
　　　　　　　　Set bk2 = Nothing
　　　　　　End If
　　　　Next
　　End With
End Sub

補足

早速のご回答ありがとうございます。
助かります。

説明不足ですみません。

BOOK1・2はそれぞれ既存のもので、BOOK1のそれぞれセルE10～29に
文字入力後、マクロが起動するようにしたいと思っています。
BOOK2は指定の項目が取得できたら自動で保存する形にしようと
思いますが、BOOK1は手動で保存します。

ご検討お願いいたします。