ファイル名を変数として取り扱いたい

質問

ファイル名が変更されても正常に動作するようにしたい
＜処理概要＞
A.XLS、B.XLS、C.XLSというファイルがあります。
A.XLSにB.XLS、C.XLSのシートを取り込む処理をしています。
マクロはA.XLSで起動、処理しています。

A.XLSのファイル名を変更されても動くようにできるのでしょうか。
ご指導のほど、よろしくお願いいたします。

＜ファイルの取り込み処理＞
For Each fName In FSO.GetFolder(MyFolder).Files
If FSO.GetExtensionName(fName) = \\\"xls\\\" And _
FSO.GetBaseName(fName) <> \"A\" Then Set wBook = Workbooks.Open(fName, 0, True)
For 番号 = 1 To Worksheets.Count
wBook.Worksheets(番号).Copy _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next 番号
wBook.Close False
End If

回答No.3

Wendy02 · ベストアンサー

こんばんは。

>マクロはA.XLSで起動、処理しています。

コードが良く分からないですね。マクロというのは、VBAのことでしょうか？
そのコードで、まともに動くのでしょうか？めちゃくちゃな内容のようにしか思えないですが。これは、あくまでも、VBAです。以下のコードは、少し、曖昧さを残しています。Copyするものは、Worksheetであって、コピーされる側は、Sheetの数に対して行われています。

'標準モジュールに登録してください。登録したブックがベースになります。

Sub Test()
　　Dim MyFolder As String
　　Dim fName As String
　　Dim sh As Variant
　　MyFolder = ThisWorkbook.Path & "\"
　　fName = Dir(MyFolder & "*.xls")
　　On Error Resume Next
　　Do While fName <> ""
　　　　If fName <> ThisWorkbook.Name Then
　　　　　　With Workbooks.Open(MyFolder & fName)
　　　　　　　　For Each sh In .Worksheets
　　　　　　　　　　sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
　　　　　　　　Next sh
　　　　　　　　.Close False
　　　　　　End With
　　　　End If
　　　　fName = Dir()
　　Loop
　　On Error GoTo 0
End Sub

お礼

ソースコードをコピーしたのですが不要な￥が表示されてしまいました。にもかかわらず実現したい処理をご理解いただき、かつコードもお示しいただきたいへん感謝いたします。
ご指導いただいたコードそのままで所望の動作になることを確認いたしました。
本当にありがとうございました。

回答No.2

A88No8

pin3891227さん、こんにちは
２行目のコードで「A.XLS」以外なら処理続行と書かれているのでA.XLSファイルが処理されて困るとい問題がでるのでは？

お礼

A.XLSをベースに処理を行うのでA.XLSファイル以外を処理するということです。
わかりにくいコードで申し訳ありませんでした。
Wendy02（回答Ｎｏ３）さんのご指導で所望の動作を実現することができました。
ありがとうございました。

回答No.1

hallo-2007

>A.XLSのファイル名を変更されても動くようにできるのでしょうか。
ですので、Thisworkbookで作成されては如何でしょうか。
試しに以下のコード実行してみてください。
Sub Macro1()
MsgBox ThisWorkbook.FullName
MsgBox ThisWorkbook.Name
MsgBox ThisWorkbook.Path
End Sub

お礼

うまく説明できず大変申し訳ありませんでした。
また、わかりにくいコードで申し訳ありませんでした。
Wendy02（回答Ｎｏ３）さんのご指導で所望の動作を実現することができました。
ありがとうございました