Excel 2013にて、指定したxlsxファイルの全シートをコピーし、セルのデータを検出する方法をご教示下さい。
当方、あまりマクロを組んだ経験がないため、ご存じの方ご教示下さると幸いです。
主題は上に書いたとおり、
(1)現在アクティブなブックから、参照ボタンでA1セルへ対象ファイルの絶対パスを表示します(現在はGetOpenFilenameで、A1セルに対象のブックのパスを表示しています。)
(2)次のボタンを押すと、GetOpenFilenameにて取得した対象ファイルの全シートを、現在アクティブなブックにコピーします。
(3)コピーしてくる際、コピーされたシート内に、例として『東京都』という文字があるセルは赤にします。こちらを参考にしました。
http://detail.chiebukuro.yahoo.co.jp/qa/question …
コピー元、コピー先の両方に、名前が被るシート名などはないため、その辺の回避はしなくてOKなのですが。
ほぼ1からで大変お手数ですが、ご教示頂ける方、ご回答下されば幸いです。
よろしくお願い申し上げます。
No.1
- 回答日時:
こんばんは!
なかなか回答が付かないようですので・・・
(1)の部分が判り難いので、コード内に保存場所のパスとファイル名を記載する方法にしてみました。
標準モジュールです。
Sub Sample1()
Dim myPath As String, fN As String, wS As Worksheet, wB As Workbook
Dim k As Long, c As Range, myRng As Range, myFlg As Boolean
myPath = "保存場所のパス\"
fN = "ファイル名.xlsx" '←拡張子は適宜変更
'▼コピー元Bookが開いていない場合はそのBookを開く
For k = 1 To Workbooks.Count
If Workbooks(k).Name = fN Then
myFlg = True
End If
Next k
If myFlg = False Then
Workbooks.Open (myPath & fN)
End If
'▼コピー元Bookを変数「wB」に格納
Set wB = Workbooks(fN)
'▼「コピー先」Bookの最終Sheet以降にSheet追加し、「コピー元」Sheetをコピー(Sheet名もコピー元Sheet名に)
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
End Sub
※ コピー元ファイルが開いていない場合は開いて操作するようにしています。
>コピー元、コピー先の両方に、名前が被るシート名などはないため・・・
とありますので、
コード内の
>wS.Name = wB.Worksheets(k).Name & "(" & k & ")" '←念のため★
の行は
>wS.Name = wB.Worksheets(k).Name
でも大丈夫かもしれません。m(_ _)m
この回答への補足
ご回答ありがとうございました。大変感謝申し上げます。
頂戴いたしましたマクロが実行出来ました。ありがとうございました。
ただ、コピー元のファイルをマクロに記述する方法を避けたく、
GetOpenFilenameにて取得したコピー元ファイルまでのフルパスを使いたいと考えております。
具体的には、ボタン(1)にてコピー元ファイルを指定し、そのファイルへのフルパスをセルA1へ取り込むようにしています。
ボタン(2)を押すと、指定したファイルの全シートを現在アクティブなブックへコピーしたいのです。
また、その際コピー元のブックを開く必要はありませんので、処理を削除させていただきました。すみません。
試行錯誤し、fN = Cells(1, 1)をSet wB = Workbooks(fN)にて変数で代入すると、「インデックスが有効範囲でない」エラーが出ます。
これはWorkbooksに対してフルパスでの記述が出来ないため、というのは分かったのですが、解決策が分からずじまいです。
現在も色々調べながらやっていますが、どうかお知恵を拝借できれば幸いです。
よろしくお願い申し上げます。
No.2ベストアンサー
- 回答日時:
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
わざわざ検証までしていただき、ありがとうございました。
心より厚く御礼申し上げます。
こちらでも頂戴いたしましたマクロが希望通りに動くことが確認出来ました。
これでかなり業務を圧縮出来そうです。本当にありがとうございました。
また、マクロの組み方、考え方も大変勉強になりましたので、今後必要なときに是非参考にさせて頂きます。
重ねて御礼申し上げます。大変助かりました。。
よろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルのマクロについて教えてください。 3 2023/02/07 14:47
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/03 11:27
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2023/03/12 12:16
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/01/26 09:50
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/03 12:30
- Visual Basic(VBA) 【困っています2】VBA 追加処理の記述を教えてください。 2 2022/08/26 11:42
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル:マクロ「Application...
-
エクセルの2ページ目の作り方
-
エクセルのアポストロフィを一...
-
エクセルで勝手に「折り返して...
-
Excel 行の連続データを列に参...
-
EXCELシートをPowerPointにきれ...
-
「選択範囲を解除してアクティ...
-
EXCELのオートフィルの設定を変...
-
メールソフト「サンダーバード...
-
Excelに、ダブルクォーテーショ...
-
エクセルでの行数・列数を指定...
-
Excel)軽いデーターのはずなの...
-
EXELで複数のとびとびのセルを...
-
エクセルオートフィルで書式を...
-
Excelでコピーした行の挿入を繰...
-
EXCEL数値が存在する列の項目名...
-
エクセル・数値が変化したらカ...
-
エクセルで隣接していない複数...
-
フォームのテキストボックスの...
-
Excelの連続データから数行おき...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル:マクロ「Application...
-
エクセルの2ページ目の作り方
-
エクセルのアポストロフィを一...
-
Excel 行の連続データを列に参...
-
エクセルで勝手に「折り返して...
-
Excelでコピーした行の挿入を繰...
-
EXCELのオートフィルの設定を変...
-
EXCELシートをPowerPointにきれ...
-
エクセルで、選択範囲の数値全...
-
Excel)軽いデーターのはずなの...
-
メールソフト「サンダーバード...
-
エクセルでの行数・列数を指定...
-
「選択範囲を解除してアクティ...
-
Excelに、ダブルクォーテーショ...
-
エクセル 別シートへのコピー...
-
エクセルオートフィルで書式を...
-
エクセルで値だけコピーして背...
-
EXELで複数のとびとびのセルを...
-
Excelで、横並べのデータを縦並...
-
エクセル・数値が変化したらカ...
おすすめ情報