★「フォルダ内の全エクセルシートを一括処理」★

質問

★「フォルダ内の全エクセルシートを一括処理」★
エクセルのマクロのコードを教えていただけますでしょうか。
★VBAの初心者です★
どなかた詳しい方、下記の内容を実行するためのコードを教えていただけませんでしょうか。

あるフォルダ内に入っている全エクセルシートの「sheet1」セルA１、B１、C1にある値を、デスクトップ上に保存されている別のエクセルシート”X” のF2、G２、H2、にそれぞれ貼り付けたい。
フォルダ内のエクセルシートは複数あるので、エクセルシートXのセルF2、G２、H2の次はF３、G３、H３、F４、G４、H４とそれぞれ１番ず つ下に貼り付けていきたい。

フォルダを検索するところから、全てのコピーが終了するところまで教えていただけると幸いです。

お忙しいところ恐れ入りますが、よろしくお願いいたします。

回答No.3

keithin · ベストアンサー

ひとつごめんなさい、うっかり間違いました。

＞マクロで開かせて値を取り出したいブックを保存してある「あるフォルダ」のプロパティを
＞右クリックして場所をコピーということですが　C:\Users\test\Desktop　

そこに表示されているのはフォルダが「置いてある場所」のパスなので、そこに「あるフォルダ」というフォルダがあるなら、マクロでは次のようにします。

修正版：
mypath = "C:\Users\ユーザー名\Desktop\あるフォルダ\"
としてください。
失礼しました。

＃このようにマクロでは「具体的なファイル名」「具体的なファイルの保存場所」「具体的なシート名」「具体的なセル番地」をイチイチ間違えるとすぐにエラーになります。既に３回目回答を重ねていますが、マクロの本質部分（ブックを拾う、開く、コピーする）にまるで入れずに、「ファイルの保存場所の指定のしかたが分からない」で延々つまづきっぱなしです。

教えてもらったマクロを丸写して実行するしかまだできないときは、こういったあなたの「具体的な名前」をキチンと詳しく正しく情報提供してご相談投稿するようになさってください。
いつまでもいつまでも「あるフォルダ」とか「あるシート」とか「あるセル」とかじゃなく、ですね。

また、丸投げ丸コピーにしても、最低限教わったマクロのそれらの記載が実際の自分のそれと間違っていないか、必ずご自分で確認し必要に応じて修正してから実行してください。

お礼

ご回答ありがとうございます。

ご指摘の通り実行した結果、無事成功することが出来ました。
ありがとうございました。

今回、自分の知識が不足している状態で、ただただ教えて下さい、のスタンスでのご質問となって
しまい大変申し訳ありませんでした。

それにも関わらず、ご丁寧に、そして迅速に教えて下さり誠に感謝しております。

もっとマクロの基本をしっかり押さえたうえで、実務を実行していきたいと思います。
このたびは本当にありがとうございました。

回答No.4

K Kazz（@JazzCorp）

'指定されたフォルダ内の全ファイル（ブック）を対象に、特定のシートの特定のセルを１つのシートに集める
'特定のシートが存在しないときは、そのブックは無視される
Sub SelectFiles()
Const xDefaultPath = "D:\tmp"
Const xFileSelector = "\*.*xls*"
Const xSheetName = "X"
Const xDataSheet = "Sheet1"
Dim xFolderPath As Variant
Dim xFileName As String
Dim xSheet As Worksheet
Dim xNoData As Boolean
Dim xShell As Variant
Dim xSh As Worksheet
Dim xLast As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
xNoData = True

Set xShell = CreateObject("Shell.Application")
Set xFolderPath = xShell.BrowseForFolder(&O0, "データ（ブック）が存在するフォルダを選択, Please!!", &H1 + &H10, xDefaultPath)
If xFolderPath Is Nothing Then Exit Sub
xFileName = Dir(xFolderPath.Items.Item.Path & xFileSelector, vbNormal)
Do Until xFileName = ""
Workbooks.Open xFolderPath.Items.Item.Path & "\" & xFileName
For Each xSheet In Worksheets
If xSheet.Name = xDataSheet Then
Set xSh = ThisWorkbook.Worksheets(xSheetName)
xLast = xSh.Cells(xSh.Rows.Count, "F").End(xlUp).Row
xSh.Cells(xSh.Rows.Count, "F").End(xlUp).Offset(1).Resize(1, 3).Value _
= Workbooks(xFileName).Worksheets(xDataSheet).Range("A1:C1").Value
xNoData = False
Exit For
End If
Next xSheet
Workbooks(xFileName).Close False
xFileName = Dir()
Loop
If xNoData = True Then
MsgBox ("No Data Found!!")
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End If
ThisWorkbook.Worksheets(xSheetName).Select
xSh.Cells(xLast + 1, 8).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

回答No.2

keithin

「ここを直しなさい」というのをスルーして何もしなければ、当然正しく動くはずもありません。
説明が分かりにくくて、理解できなかったようでごめんなさい。

アナタのご質問：
＞あるフォルダ内に入っている全エクセルシートの「sheet1」セルA１、B１、C1にある値を
　~~~~~~~~~~~~~~~~~~~~~~~~~

どこにあるのか判りませんが、このフォルダのパスを
＞mypath = "c:\あるフォルダ\"　’言わずもがなですが正しく記入すること

ここに記入しなさいという意味です。

＞このコードでデスクトップ上の「あるフォルダ」フォルダのパスコード取得になるのでしょうか。

どうやらパスの調べ方も判らないみたいなので、次の通りにします

１．ウィンドウズの画面上であなたの「あるフォルダ」を右クリックしてプロパティを表示する
２．「場所」としてC:\test　といった具合に表示されるのでコピーする
３．「mypath = "c:\あるフォルダ\"」の代わりに「mypath = "c:\test\"」といった具合に修正する
　　一番最後に「￥」が付いているのを見落としてまた失敗しないよう、気を付けること

また間違えないように、「あるフォルダ」はブックを保存してある（マクロで開かせて値を取り出したい）ブックを保存してある方のフォルダのことです。
マクロを付けたブック（値を貼り付ける方のブック）は、最初に回答したようにあなたの最初のご質問に書かれている通り、デスクトップに置いておきます。
値を張り付けて集める「シート」は、ご質問であなたがご自分で書いた通りシート名をXにしておかなきゃいけないので、そこも忘れないように気を付けて下さい。

補足

ご回答ありがとうございます。

ご丁寧にありがとうございますm(__)m
パスの調べ方も知らない初心者で恥ずかしい次第です。

アドバイス通り実行いたしましたところ、
「実行時エラー９　　インデックスが有効範囲にありません」

と表示されました。

ThisWorkbook.Worksheets("X").Range("F65536").End(xlUp).Offset(1).Resize(1, 3).Value _
= Workbooks(myFile).Worksheets("Sheet1").Range("A1:C1").Value

ここの値のどこがが違うことを示すエラーと認識しておりますが、

マクロで開かせて値を取り出したいブックを保存してある方のフォルダ（デスクトップ上にフォルダを作成しました。）に入っている各エクセルシート達sheet1のA１～C１には間違いなく値が入っているため、
コードエラーの原因がわかりません。

フォルダ内の各エクセルのファイル名は特にこの今回のアクションとは無関係でしょうか？？
（フォルダ内に入っている各エクセルシート達はばらばらな名前です）

また、マクロで開かせて値を取り出したいブックを保存してある「あるフォルダ」のプロパティを
右クリックして場所をコピーということですが　C:\Users\test\Desktop　

デスクトップ上に存在するファイルたちは全て同じ場所（パス）表示になるのでしょうか。
どのように、自分が抽出したいエクセルが入っているフォルダを選んでいるのか不思議です。
（現在デスクトップには１つしかファイルは存在していませんが）

初心者じみたばかりの質問で本当に申し訳ありません。

回答No.1

keithin

デスクトップにデータをまとめるためのまとめブックを用意しておく
まとめブックを開いてマクロを登録し、実行する。

手順：
まとめブックを開く
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim myPath as string
　dim myFile as string

　mypath = "c:\あるフォルダ\"　’言わずもがなですが正しく記入すること
　myfile = dir(mypath & "*.xls*")

　do until myfile = ""
　　workbooks.open mypath & myfile
　　thisworkbook.worksheets("X").range("F65536").end(xlup).offset(1).resize(1,3).value _
　　　= workbooks(myfile).worksheets("Sheet1").range("A1:C1").value
　　workbooks(myfile).close false
　　myfile = dir()
　loop
end sub

補足

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

ご教授頂いた通り、そのままコピーし、実行いたしましたが、対象のまとめシート上でマクロ実行したところ何も起きませんでした。

エラー等は特に発生しなかったので、コード自体に間違いはないかと思いますが、原因はなにが想定されますでしょうか？

・デスクトップに保存しているファイル名は「あるフォルダ」にしております。

・mypath = "c:\あるフォルダ\"　
　このコードでデスクトップ上の「あるフォルダ」フォルダのパスコード取得になるのでしょうか。

お忙しいところ大変恐れ入りますが、ご教授いただけますと幸いです。
何卒よろしくお願いいたします。