ファイル名変更後も、マクロを動作させたいのですが？

データ入力用雛形ファイル（入力用.xls）に、データ入力完了後、保存用マクロでデータ部分だけをデータベース蓄積用ファイル（データ.xls）に、コピー・ペースト（数回に分けて）し、元の入力用.xlsを名前を変えて（日付＆時間＆ＩＤ番号.xls）別名保存する、マクロを作りました。

通常はうまくいくのですが、マクロの動作後、訂正箇所が発生したときに、現状ではマクロが正しく動作しません。（ファイル名が変わっているため？）

どなたか教えていただけないでしょうか？
よろしくお願いします。

No.2 ベストアンサー 回答者： Wendy02 回答日時： 2005/09/03 23:55

こんばんは。

＞元の入力用.xlsを名前を変えて（日付＆時間＆ＩＤ番号.xls）別名保存する、マクロを作りました。

そのコードを見る限りでは、やはり、ブック名の問題だと思います。
ここでは、別名保存するマクロは見られませんが、少し、分りやすいようにまとめてみました。

それで、入力用のブック側に以下のマクロを設ければ、仮に、ブック名が変わっても、問題は起こらないのではないかと思います。

ただし、別のブック（入力用ブック以外）に、このコードを置くとなると、もう少し手を加えなくてはなりません。そのためには、ブック名を探すための正しい規則が必要になってしまいます。

それから、
'2行以上が必要
と、コードの中に注釈がありますが、シートのデータの状態が分りませんので、エラー処理はしません。


Sub TestSample1()
Dim DataBK As Workbook

　　Workbooks.Open Filename:= _
　 "C:\Documents and Settings\MyDocuments\一時保存\excel-test\データ.xls"

　 'Windows.Arrange ArrangeStyle:=xlTiled
　 '↑これは入りませんね。

　 Set DataBK = Workbooks("データ.xls")
　
　 With ThisWorkbook　'(入力用.xls）
　　 .Worksheets("Sheet2").Range("A1").Copy _
　　　DataBK.Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0)
　　　'2行以上が必要
　　
　　　.Worksheets("Sheet1").Range("A4").Copy _
　　　DataBK.Worksheets("Sheet2").Range("A1").End(xlDown).Offset(1, 0)
　　　'2行以上が必要
　　　DataBK.Close True
　
　　　ActiveWindow.WindowState = xlMaximized
　　　Application.Goto .Worksheets("Sheet1").Range("E13")
　 End With
　
End Sub

この回答へのお礼

助かりました。

回答のとおり、”ThisWorkbook”と言うコマンド（コマンドっていうのかな？）を使うことで解決しました。

ありがとうございました。

お礼日時：2005/09/04 11:59

No.1 回答者： Wendy02 回答日時： 2005/09/03 13:56

こんにちは。

一体、どこにマクロコードが置かれているのか分りませんが、
＞データベース蓄積用ファイル（データ.xls）に、コピー・ペースト（数回に分けて）し、

ということで、データ.xls の目的のファイルが変わらないのでしたら、後は、ActiveBook にすればよいのではありませんか？

＞通常はうまくいくのですが、マクロの動作後、訂正箇所が発生したときに、
＞現状ではマクロが正しく動作しません。（ファイル名が変わっているため？）

コードなしでは、分りません。
もう少し、詳しい具体的な内容が必要です。

この回答への補足

質問の仕方が中途半端だったようですいません。

マクロの記録で下記のようなマクロになっています。（Offset(1, 0).と言うところだけ他のサイトで調べて手入力しています。）どこをどのように打ちかえればいいのか教えていただけたら幸いです。

よろしくお願いします。


Sub データセーブ()
'
' データセーブ Macro

'
Workbooks.Open Filename:= _
"C:\Documents and Settings\MyDocuments\一時保存\excel-test\データ.xls"
Windows.Arrange ArrangeStyle:=xlTiled
Windows("入力用.xls").Activate
Sheets("Sheet2").Select
Range("A1").Select
Selection.Copy
Windows("データ.xls").Activate
Sheets("Sheet1").Select
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("入力用.xls").Activate
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("データ.xls").Activate
Sheets("Sheet2").Select
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.WindowState = xlMaximized
Sheets("Sheet1").Select
Range("E13").Select
End Sub

補足日時：2005/09/03 19:11

この回答へのお礼

早速の回答ありがとうございました。

質問内容が不適切だったようです、すいません

補足を入力しましたので、お手すきがありましたら、またよろしくお願いします。

お礼日時：2005/09/03 19:14