エクセルファイルの統合方法
- エクセルで複数のファイルを一つのファイルに統合する方法について解説します
- Excel2010でのエクセルファイルの統合方法について説明します
- Windows7（64bit）の環境でエクセルファイルの統合を行う際の注意点を解説します
- ベストアンサー
複数のエクセルファイルの統合について
エクセルで複数のファイルを一つのファイルに統合したいのですが、 これまでＥｘｃｅｌ２００７を使用していた時は、 OKWaveの過去の回答（質問:No.2186548）を参考に、 下記のマクロをコピーして実行できていたのですが、 Excel2010に更新してから試したところ、上手く実行できません。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelファイルを検索 Do Until fname = Empty '全て検索し終えると、fname = Empty となるので、その間以下を実行 If fname <> mb.Name Then 'ファイル名がこのファイルじゃなければ Set wb = Workbooks.Open(myfdr & "\" & fname) '選択したファイルを開く wb.Worksheets.Copy Before:=mb.Sheets(mb.Sheets.Count) 'コピーしてまとめ用ブック末尾に置く wb.Close '選択したファイルを閉じる n = n + 1 'ブック数をカウント End If fname = Dir '選択したフォルダ内の次のExcelファイルを検索します Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをまとめましました。" End Sub 上から5行目の、『.xls』で引っかかっているのかなと、拡張子を『xlsx』に 変更してみましたが、統合処理が出来ませんでした。 上記マクロをどのように書き換えればよいか教えて頂けると助かります。 なお、OSはWindows7（64bit）です。
- Kumahiko-20XX
- お礼率100% (6/6)
- その他MS Office製品
- 回答数3
- ありがとう数3
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
とりあえず fname = Dir(myfdr & "\*.xls*") とでもしてみます。 ご自分が実際に保存しているファイルの拡張子を、ご自分の手と目で調べてマクロに反映するだけなんですけどね。
その他の回答 (2)
- Nouble
- ベストアンサー率18% (330/1783)
補足をお願いします。 愚問だと思いますが 手動ではダメですか？
お礼
回答ありがとうございました。 No.2さんのアドバイスを元に無事解決できました。
補足
ファイル数が100を超えると、流石につらいなと。。。
- K Kazz（@JazzCorp）
- ベストアンサー率31% (549/1751)
＞Excel2010に更新してから試したところ、上手く実行できません。 ドオ、不味いのか？？ サッカク？、モトモト、美味くいってるわけでもないのでは？？
お礼
回答ありがとうございました。 No.2さんのアドバイスを元に無事解決できました。
補足
マクロを実行すると 『 件のブックをまとめましました』 と表記され、ファイルを統合せずに処理が終了して しまいます。 なお、統合する親ファイルと子ファイルをそれぞれ、 旧バージョンのエクセルファイル形式（.xls）で 保存しなおすたところ、上手く統合されました。 根本的な解決にはなっていないですけど・・・
関連するQ&A
- Ｅｘｃｅｌ マクロで複数ブックのデータを一つのブックにまとめる方法
マクロ初心者です。 1つのフォルダの中に複数のbook（sheetも複数）があります。 これを新しい1つのbookにまとめたいです。 sheetは「bookを開いた時に表示されるsheetだけ」を新しいbookにまとめたいです。 どなたかの回答に下記マクロがありました。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く wb.Close '開いたブックを閉じる n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをコピーしましました。" End Sub 非常によかったのですが、これですと (1)全てのsheetがコピーされてしまいます。 (2)また、保存しますか？とbookごとに聞いてきます。 上記のマクロのどこを変更すれば、(1)(2)を解決できますでしょうか？ （エクセルは2002です） 以上、よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Ｅｘｃｅｌ マクロで複数ブックのデータを一つのブックにまとめる方法
マクロ初心者です。 1つのフォルダの中に複数のbook（sheetも複数）があります。 これを新しい1つのbookにまとめたいです。 回答に下記マクロがありました。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く wb.Close '開いたブックを閉じる n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをコピーしましました。" End Sub これで使用した所マクロを実行する度に何度も同じシートが コピーされてしまいます。 できれば同じ名前のシートは上書きにしてマクロを何度も使用できるように【各BOOKは毎週更新されて私のフォルダに入ってきます】したいのですが そのような事は可能なのでしょうか？ どなたか分かる方教えてください。お願い致します。
- ベストアンサー
- オフィス系ソフト
- マクロで複数ブックのデータを一つのブックにコピー
マクロ超初心者です。 1つのフォルダの中に複数のbook（sheetも複数）があります。 これを新しい1つのbookにまとめたいです。 sheetは「bookを開いた時に表示されるsheetだけ」を新しいbookにまとめたいです。 どなたかの回答に下記マクロがありました。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く wb.Close '開いたブックを閉じる n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをコピーしましました。" End Sub このマクロを使わせていただき、 これでいける！と思ったのですが、255文字以上のコピーが出来ません。 どのようにすればよいでしょうか？
- 締切済み
- オフィス系ソフト
- エクセルVBAでBOOKに読み取りパスワード設定
エクセル2013です。 以下のコードで指定した任意のフォルダ内のエクセルに読み取りパスワードを設定できました。 しかし、そのフォルダの下にサブフォルダーがあった場合にサブフォルダ内のBOOKは対象になりません。どのように直せばサブフォルダも対象にできるようになるでしょうか？教えてください。 Sub TEST01() Dim myfdr As String, fname As String Dim mb As Workbook, wb As Workbook Dim n As Long With Application.FileDialog(msoFileDialogFolderPicker) '対象とするフォルダの指定 If .Show = True Then myfdr = .SelectedItems(1) Else MsgBox "キャンセルします。" Exit Sub End If End With Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 fname = Dir(myfdr & "\*.xls*") 'フォルダ内のExcelブックを検索 n = 2 Do Until fname = Empty '全て検索 Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 With mb.Sheets("Sheet1") '転記 .Cells(n, "B").Value = wb.FullName .Cells(n, "C").Value = wb.Sheets(1).Range("B1").Value End With n = n + 1 'カウント Application.DisplayAlerts = False wb.SaveAs Filename:=wb.FullName, Password:="emaxemax" wb.Close Application.DisplayAlerts = True fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す MsgBox n - 2 & "件処理しましました。" End Sub
- ベストアンサー
- Excel（エクセル）
- VBAのエラーで、セルの書式が多すぎるため書式を追加できません。
Excel２００３のＶＢＡで質問です。 複数ブック→1つのブックで複数シート にするマクロを作成しています。 今まではうまく実行できていたのですが、 wb.Sheets("12月").Range("A1:AO45").Copy mb.Sheets(mb.Sheets.Count).Range("A1").Select mb.Sheets(mb.Sheets.Count).Paste を追加したところ、途中までは大丈夫なのですが、ある一定数以上のブックで 「セルの書式が多すぎるため書式を追加できません」とメッセージが出ます。 VBAのどの辺りを修正すればよいのでしょうか？ また、都度 「コピーまたは移動先セルの内容を置き換えますか？」や「クリップボードにおおきな情報があります。この情報を貼り付けられるようにしますか？」などに「Y」や「N」を都度入力しなくてもよいようにできますでしょうか？ 以上、よろしくお願いします。 下記は全マクロ。 Sub Consolid03() Dim mb As Workbook, wb As Workbook Dim myfdr As String, fname As String, n As Integer Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Sheets("12月").Copy After:=mb.Sheets(mb.Sheets.Count) '開いたシートをコピーしてmbの末尾に置く wb.Sheets("12月").Range("A1:AO45").Copy mb.Sheets(mb.Sheets.Count).Range("A1").Select 'コピー先シートを選択してアクティブにする mb.Sheets(mb.Sheets.Count).Paste wb.Close (False) '有無を言わずに保存せず閉じる mb.Sheets(mb.Sheets.Count).Unprotect Password:="9" 'パスワード解除 For Each c In mb.Sheets(mb.Sheets.Count).UsedRange '取り込んだシートの使用範囲に If c.FormulaR1C1 Like "=*!*" Then '他シート参照があれば c.Value = c.Value '値に変更 End If Next n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 Dim ws As Worksheet '全てのシートの色をなしにする For Each ws In Worksheets ws.Tab.ColorIndex = xlColorIndexNone Next MsgBox UCase(Environ("UserName")) & "さん、" & n & "件のブックをコピーしましました。" _ + Chr(&HD) + Chr(&HA) + "他シートを参照する式だけは値にしておきましたよ。" _ + Chr(&HD) + Chr(&HA) + "" _ + Chr(&HD) + Chr(&HA) + "", , "（￣ー￣）v " End Sub
- ベストアンサー
- その他MS Office製品
- 【VBA】特定の文字が入っている行の一部を抽出
マクロ初心者です。 一つのフォルダにある複数のエクセルファイルから”山口県”の行を 抽出するマクロを作成していますが、抽出条件をもう一つ追加したいのですがマクロの作成方法がわかりません。 現在下記のマクロを作成済みですが、こちらは”C”列に”山口県”と入力済みのデータを抽出しています 作成したいのは”C”列に”山口県” ”D”列に”宇部市”と入力済みのデータの抽出を行いたいです。 ↓現在作成済みのマクロです Sub test01() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 With wb.ActiveSheet 'wbの開かれたシートについて x = .Cells(Rows.Count, "C").End(xlUp).Row 'A列最終行をxに代入 For i = 1 To x '1～xまで繰り返し If .Cells(i, "C").Value = "G1" Then '値がヒットしたら n = n + 1 .Rows(i).Copy 'コピー mb.Sheets(1).Rows(n).PasteSpecial 'このブックの最初のシートに貼り付け Application.CutCopyMode = False End If Next i End With wb.Close (False) '保存の有無を聞かずに保存しないで閉じる End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 Set mb = Nothing Set wb = Nothing End Sub マクロ初心者のため説明不足等でご迷惑をおかけするかと思いますが ご回答お願い致します。
- ベストアンサー
- Visual Basic
- VBAでシート名を変える、グラフのリンクを切る等を教えてください
以前、「複数ブックのシートを一つのブックにコピーする」ＶＢＡを教えていただきました。 そこで、誠に恐縮なのですが、下記を追加するにはどのようにすればよいのでしょうか？ 1、コピー元とのグラフのリンクを解除する。 数式のリンクは解除されているので、恐らくグラフのリンクが解除されていない。毎回、編集→リンクの設定で解除している。 2、シート名をセルＢ２の５文字目以降にしたい。 3、1つのセルに255文字以上入力されている、以降の文字がコピーしない現象を回避。 シートのコピーをすると、255文字以降がコピーされない？？ セルを範囲選択してコピーした場合は、コピーできる。 4、最後に「Sheet1」を削除 下記が現在のＶＢＡです。 Sub Consolid03() Dim mb As Workbook, wb As Workbook Dim myfdr As String, fname As String, n As Integer Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) '開いたシートをコピーしてmbの末尾に置く wb.Close (False) '有無を言わずに保存せず閉じる mb.Sheets(mb.Sheets.Count).Unprotect Password:="9" 'パスワード解除 For Each c In mb.Sheets(mb.Sheets.Count).UsedRange '取り込んだシートの使用範囲に If c.FormulaR1C1 Like "=*!*" Then '他シート参照があれば c.Value = c.Value '値に変更 End If Next mb.Sheets(mb.Sheets.Count).Protect Password:="9" 'パスワード保護 n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox UCase(Environ("UserName")) & "さん、" & n & "件のブックをコピーしましました。" _ + Chr(&HD) + Chr(&HA) + "他シートを参照する式だけは値にしておきましたよ。" _ + Chr(&HD) + Chr(&HA) + "" _ + Chr(&HD) + Chr(&HA) + "取りこんだシートにパスワード保護もかけておきましたよ。", , "（￣ー￣）v " End Sub 以上、ご教示願います。。。
- ベストアンサー
- オフィス系ソフト
- 新しく開いたブックをアクティブにするマクロ
マクロ 新しく作ったブックをアクティブにする マクロ初心者です。 マクロを使って同階層にあるファイルのアクティブのシートを ひとつのブックにコピーして保存するマクロを作りたいと思ってます。 他の質問を参照して下記のコードを途中まで作成しました。 参照した質問では、 マクロの入っているブックにシートをコピーするようでしたが、 そうすると保存した時にマクロも保存されてしまうので 私なりに調べて、新しいブックにシートコピーするようにしましたが、 この記述の後、新しいブックをアクティブにする記述がわからず、 保存できなくなってしまいました。 ここまで終わるとマクロの入っているブックがアクティブになって終わります。 このあと新しく開いたブックをアクティブにして、 ブックのsheet1～3を削除して、名前をつけて保存したいのですが 開いたブックをアクティブにするマクロをご伝授ください。 あたらしくブックをつくるとbook1～・・・と名前が変わってしまうので 変数で名づけたいのですが、やり方が良くわかりませんのでよろしくお願いします。 何卒よろしくお願いします。 Sub consolid_test() Dim shCnt As Integer Dim Wb As Workbook Dim i As Integer Dim sh As Worksheet Dim nSh As Worksheet Dim fName As String Dim ka As String Application.ScreenUpdating = False '画面更新を一時停止 Application.DisplayAlerts = False Set mb = Workbooks.Add '新しいコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fName = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fName = Empty '全て検索 If fName <> mb.Name Then 'ブック名がこのブックの名前でなければ Set Wb = Workbooks.Open(myfdr & "\" & fName) 'そのブックを開きwbとする。 Wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く ActiveSheet.Name = Range("B16") 'シート名の変更 ActiveSheet.Unprotect 'シート全体をコピーして値にする Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Wb.Close (False) '保存の有無を聞かずに保存しないで閉じる N = N + 1 'ブック数をカウント End If fName = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す ・ ・ ・ ・
- ベストアンサー
- Visual Basic
- 複数シートをブックにするマクロを応用して。。
1ブック内にyymmdd（日付）シートが多数あり、それを月別yymmごとブックを作成するマクロです。 これは以前、回答して頂いた「n-jun」さんの構文です（n-junさん、重宝しています、感謝！） Private Sub CommandButton1_Click() Dim myDic As Object Dim wb1 As Workbook Dim wb As Workbook Dim ws As Worksheet Dim sh As Worksheet Dim myKey Set myDic = CreateObject("Scripting.Dictionary") Set wb1 = ThisWorkbook Application.ScreenUpdating = False For Each sh In wb1.Worksheets myDic(Left(sh.Name, 4) & "_") = Empty Next For Each myKey In myDic.keys For Each sh In wb1.Worksheets If InStr(sh.Name, Left(myKey, 4)) > 0 Then If wb Is Nothing Then wb1.Worksheets(sh.Name).Copy Set wb = ActiveWorkbook Else wb1.Worksheets(sh.Name).Copy after:=wb.Sheets(wb.Sheets.Count) End If End If Next Application.DisplayAlerts = False wb.SaveAs Filename:="C:\仕事\月別" & "\" & Left(myKey, 4) & ".xls" wb.Close Set wb = Nothing Application.DisplayAlerts = True Next Application.ScreenUpdating = True Set myDic = Nothing Worksheets("main").Activate MsgBox "出力完了" End Sub 実は、これをフォルダ内のブックの場合は？ として応用ができないか悩んでいます。 つまり、フォルダ内にyymmddブックが多数あり、 これを月別yymmとして、それぞれまとめたいのです。 Set wb1 = ThisWorkbookの箇所が、 フォルダ内のブック指定になると思うのですが、 下記コードでどうなんでしょうか？動きません。 myfdr = "C:\仕事\月別" fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 Set wb1 = Workbooks.Open(myfdr & "\" & fname) 変更箇所、アドバイス頂ければ助かります。お願いします
- ベストアンサー
- オフィス系ソフト
- 同一フォルダの複数ブックの値を取得マクロ
エクセル２０１０のマクロで困っています。 同一フォルダ内・複数ブックの 「異動表」というシートの特定のセルを抽出し、一覧にするマクロを素人ながら作成しようとがんばっています。 下記、マクロを作成したのですが、 必ず、９８件（９８ブック）前後でマクロが止まってしまいます。 【Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。】←ここで止まります。 なぜなのでしょうか？？ご教授願います。 Sub (1)() Dim mb As Workbook, wb As Workbook Dim myfdr As String, fname As String, n As Integer Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xlsx") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Sheets("異動表").Range("A1").Copy '選択＆コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("a1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("b1").Copy '選択＆コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("b1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("b4").Copy '選択＆コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("c1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("m2").Copy '選択＆コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("d1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("退職金計算書").Range("d21").Copy '選択＆コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("e1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 Application.ScreenUpdating = True 'コピー先のセルの内容を置き換えますか？＝YES Application.DisplayAlerts = False '警告表示を出さない Application.CutCopyMode = False 'クリップボードのコピーを消す wb.Close (False) '有無を言わずに保存せず閉じる For Each c In mb.Sheets(mb.Sheets.Count).UsedRange '取り込んだシートの使用範囲に If c.FormulaR1C1 Like "=*!*" Then '他シート参照があれば c.Value = c.Value '値に変更 End If Next n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 Dim ws As Worksheet '全てのシートの色をなしにする For Each ws In Worksheets ws.Tab.ColorIndex = xlColorIndexNone Next MsgBox UCase(Environ("UserName")) & "さん、" & n & "件のブックをコピーしましました。" _ + Chr(&HD) + Chr(&HA) + "他シートを参照する式だけは値にしておきましたよ。" _ + Chr(&HD) + Chr(&HA) + "" _ + Chr(&HD) + Chr(&HA) + "", , "（￣ー￣）v " End Sub
- ベストアンサー
- その他MS Office製品
お礼
回答ありがとうございました。 アドバイス通り、 fname = Dir(myfdr & "\*.xls*") で、無事にファイル統合できました。 以前、CSVファイルを統合したことがあって、 その時は、\*.csvへ書き換えることで統合できたのですが、 xlsxに書き換えても反応しなかったので、困っておりました。 試しに、CSVファイルの統合に、\*.csv*を使ってみた ところこちらも無事に統合できました。 無事解決できたため、ベストアンサーとさせて頂きます。