任意のフォルダの中に、特定の名前がついたシートがあるファイルが複数あります。
特定の名前のシートのみコピーして、一つのファイルに集約したいです。
ダメもとで公開されている2003仕様の下記のコードを試してみたのですが、うまくいきません。
これを2007以降でも動くようにするには、どう直せばいいでしょうか。
(もし大改築しなければならないのでしたら、別の方法を考えます。なお拡張子の部分のみ、手を加えてあります)
どうぞよろしくお願い致します。
Sub すべてのブックから指定シートを取り込む()
'オブジェクトを設定する
Set ファイルシステム = CreateObject("Scripting.FileSystemObject")
'指定するシート名を取り込む
対象シート = Cells(1, 1).Text
'読み込むファイルを1個指定する
あるブック = Application.GetOpenFilename("Excelファイル(*.xlsm),*.xlsm")
'親フォルダーを取得する
Set 親フォルダー = ファイルシステム.GetFile(あるブック).ParentFolder
'親フォルダー内の全ファイルに以下の操作をする
For Each ファイル In 親フォルダー.Files
'ファイルを開く
Workbooks.Open ファイル.Path
'ブック名を記憶する
ブック名 = ActiveWorkbook.Name
'開いたファイルの対象シートを右端シートの後ろにコピーする
ActiveWorkbook.Worksheets(対象シート).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
'開いたファイルを閉じる
Workbooks(ブック名).Close SaveChanges:=False
'シート名を変更する
ThisWorkbook.Worksheets(対象シート).Name = 対象シート + ファイル.Name
Next
End Sub
A 回答 (3件)
- 最新から表示
- 回答順に表示
No.3
- 回答日時:
#2の回答者です。
>頂きましたコード、ちょっと間があいてしまうのですが、試してみたく思います。
いえ、試す必要性はないのですが、もう一度書き直すべきかは思案中です。
「このマクロそのものが変です。」という意見は変わらないです。
成立するのは、特殊な環境だけです。
動く・動かないというに関わらず、コードは書き換えなくてはいけないです。
>For Each ファイル In 親フォルダー.Files
>'ファイルを開く
If ファイル.Type Like "XLSM*" Then '例えば、このようなフィルターを置く
>Workbooks.Open ファイル.Path
・
・
End If
Next
そのままですとExcelのOpenメソッドに、あらゆるゴミファイルが入り込んでしまいます。
No.2
- 回答日時:
こんにちは。
現在のVBAというのは、VB6.0 系ですから、Office 97 ぐらいから、基本的には変わっていないと思います。特に、2003は、画期的だったのは、.FrameWork を利用できるのと、VB6のRuntimeを搭載しているということです。現在は、VB7 になっていますが、さほど影響はないと思われます。
ところで、このマクロそのものが変ですね。
>もし大改築しなければならないのでしたら、別の方法を考えます
ということでしたので、なるべく、全体的な雰囲気を壊さないでつなげてみました。
(ほとんどを英語に変えてはいますが……)
>あるブック = Application.GetOpenFilename("Excelファイル(*.xlsm),*.xlsm")
>'親フォルダーを取得する
>Set 親フォルダー = ファイルシステム.GetFile(あるブック).ParentFolder
>'親フォルダー内の全ファイルに以下の操作をする
>なお拡張子の部分のみ、手を加えてあります
元の作者は、あえて、ファイルシステムオブジェクトを使おうとしていたように思います。
これは、ファイルシステムオブジェクトを活かそうとるすと、逆に、ややこしいです。
以下は、見本とは言えません。返って、ややこしくしているし、マクロを使うのにためらいを感じます。
以下は、「親フォルダーを取得する」が、二重になっていてお世辞にも褒められないコードになってしまいました。バカなコードを書いたという自覚はあります。(^^;
'//標準モジュールがよい
Sub getSheetsinSelectedBooks()
Dim objFSO As Object
Dim 対象シート As String 'ソースのシート名
Dim BaseFolder As String
Dim objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'指定するシート名を取り込む
対象シート = ActiveSheet.Cells(1, 1).Value
'親フォルダーを取得する
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
BaseFolder = .SelectedItems(1)
End If
End With
'親フォルダー内の全ファイルに以下の操作をする
Set objFolder = objFSO.Getfolder(BaseFolder)
For Each fn In objFolder.Files
'ファイルを開く
If Dir(fn.Name, vbNormal) Like "*.xlsm" Then '拡張子
With Workbooks.Open(fn.Path)
'開いたファイルの対象シートを右端シートの後ろにコピーする
.Worksheets(対象シート).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
'シート名を変更する
ThisWorkbook.ActiveSheet.Name = 対象シート & fn.Name
'開いたファイルを閉じる
.Close False
End With
End If
Next
End Sub
ご回答ありがとうございます。
あまりにもカッコワルイ結末なのですが、皆様から補足要求を受けた上で再度テストをしてみましたら、何の問題もなく動きました。
以前テストした際は確か
「シートの取り込み」ボタン押下
↓
「ファイルを開く」ウィンドウが立ち上がる
↓
ファイルを選んで「開く」ボタン押下
↓
何も起こらずに終了
だったような気がするのですが…大変失礼致しました。
頂きましたコード、ちょっと間があいてしまうのですが、試してみたく思います。
そのため、この質問はしばらくは締め切らずにおこうと思います。
No.1
- 回答日時:
逆は良くありますが…
ちなみにどこかでエラーが出るのでしょうか?出るならばそれを提示してください。
出ないのならば何が出来ないかを提示してください。
ちなみに「あるブック = Application.GetOpenFilename("Excelファイル(*.xlsm),*.xlsm")」は、どう見ても Excel2007 以降の物ですけど…
ここだけ直したと言う事ですか?これだとマクロ有効のファイルのみの選択になり、通常の拡張子が「xlsx」の物は対象外になりますけど…
ご回答ありがとうございます。
あまりにもカッコワルイ結末なのですが、皆様から補足要求を受けた上で再度テストをしてみましたら、何の問題もなく動きました。
以前テストした際は確か
「シートの取り込み」ボタン押下
↓
「ファイルを開く」ウィンドウが立ち上がる
↓
ファイルを選んで「開く」ボタン押下
↓
何も起こらずに終了
だったような気がするのですが…大変失礼致しました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) シートをコピーする下記記述でダイアログを用いた記述がわかりません?( A = Dir(ThisWor 4 2022/08/22 12:26
- Excel(エクセル) 複数のブックをひとつのブック(複数のシートにまとめる)場合にシートとの順番について 5 2022/12/28 20:47
- Excel(エクセル) 【マクロ】マクロが保存されているエクセルとは、別のエクセルブックの全シートの非表示列を再表示したい 1 2022/12/24 20:48
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
【ExcelVBA】zip圧縮されたCSV...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
ワイルドカード「*」を使うとう...
-
【困っています2】VBA 追加処...
-
VBA シート名が一致した場合の...
-
EXCEL VBA 単語置き換え につい...
-
ExcelのVBAです。フォルダ内の...
-
エクセル VBA 他シートの行を選...
-
エクセルVBAで書式と値の貼付け...
-
VBA 別ブックからコピペしたい...
-
VBS Bookを閉じるコード
-
マクロで最終行を取得したい
-
【前回の続き続きです、ご教示...
-
クリップボードに貼付している...
-
Excel-VBAでのファイルの開き方
-
VBAで別ブックのシートを指定し...
-
【マクロ】違うフォルダにある...
-
VBSでExcelのオープン確認
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
別ブックをダイアログボックス...
-
ワイルドカード「*」を使うとう...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
VBS Bookを閉じるコード
-
【ExcelVBA】インデックスが有...
-
VBA コードを実行すると画面が...
-
【ExcelVBA】zip圧縮されたCSV...
-
vbaでvbaProjectのパスワード解...
-
VBAで別ブックのシートを指定し...
-
ExcelのVBAです。フォルダ内の...
-
vbaで他のブックに転記したい。...
-
フォルダ内の全てのファイルに...
-
VBAで複数のブックを開かずに処...
-
VBSでExcelのオープン確認
-
VBA 実行時エラー 2147024893
-
【Excel VBA】書き込み先ブック...
-
VBA シート名が一致した場合の...
おすすめ情報