Excel シートの取り込みとデータ検出方法

質問

• Excel 2013で指定したxlsxファイルの全シートをコピーし、セルのデータを検出する方法を教えてください。
• Excel 2013のマクロを使用し、指定したxlsxファイルの全シートを現在のブックにコピーする方法を教えてください。
• Excel 2013でコピーしたシートの内容を検出し、特定の文字が含まれるセルを赤色にする方法を教えてください。

回答No.2

tom04 · ベストアンサー

No.1です。
ブックを開かずに！というのは↓のサイトにあるようにExcel4.0なるものを使用すれば可能のようです。

http://officetanaka.net/excel/vba/tips/tips28.htm

ただ結構面倒な感じがしますので、
画面更新をせず「コピー元ファイル」を開き　→　そのファイルの各Sheetをコピー＆ペースト　→　条件セルに色付け　→　「コピー元ファイル」を閉じる
といった操作ではどうでしょうか？

そして
＞fN = Cells(1, 1)をSet wB = Workbooks(fN)にて変数で代入すると・・・
に関しては
Application.GetOpenFilenameでA1セルに保存場所のパスとファイル名が取得できている！というコトですので、
変数に格納せずそのままA1セルの「文字列」（保存場所のパス＆ファイル名）を使用してはどうでしょうか？

Sub Sample2()
Dim wS As Worksheet, wB As Workbook
Dim k As Long, c As Range, myRng As Range

Application.ScreenUpdating = False
'▼　GetOpenFilename　でA1セルにコピー元のパスとファイル名が取得できているという前提
Workbooks.Open (Range("A1"))

Set wB = ActiveWorkbook
ThisWorkbook.Activate
For k = 1 To wB.Worksheets.Count
Worksheets.Add after:=ActiveWorkbook.Worksheets(Worksheets.Count)
Set wS = ActiveSheet
wS.Name = wB.Worksheets(k).Name & "(" & k & ")" '←念のため★
wB.Worksheets(k).Cells.Copy wS.Range("A1")
Set myRng = wS.Cells.Find(what:="東京都", LookIn:=xlValues, lookat:=xlPart)
If Not myRng Is Nothing Then
For Each c In wS.UsedRange
If InStr(c, "東京都") > 0 Then
Set myRng = Union(myRng, c)
End If
Next c
myRng.Interior.ColorIndex = 3
End If
Next k
wB.Close
Application.ScreenUpdating = True
End Sub

※　とりあえずこちらで
A1セルにApplication.GetOpenFilenameで
選択したファイルの「パスとファイル名」を取得しやってみたところ
一応動作確認はできています。m(_ _)m

お礼

わざわざ検証までしていただき、ありがとうございました。
心より厚く御礼申し上げます。

こちらでも頂戴いたしましたマクロが希望通りに動くことが確認出来ました。
これでかなり業務を圧縮出来そうです。本当にありがとうございました。
また、マクロの組み方、考え方も大変勉強になりましたので、今後必要なときに是非参考にさせて頂きます。

重ねて御礼申し上げます。大変助かりました。。
よろしくお願いいたします。