<スポンサーリンク>
必要なところをコピーしてvbaに張り付け。もしくは、すべてをコピーしてCallで呼び出してもらえたらと思います。
表の計算などを始めるときに、BOMなど元のデータを壊さないようにブックのデータやシートのデータをコピーしてから始めるとうまくいきます。そのために最初に必要なプログラムです。
選択したブックのシートをコピー
①Application.GetOpenFilenameを使って、エクセルのブックを選択。
②選択したブックのアドレスを拾って、開きアクティブになっているシートをコピー。
③もともとのブックに張り付けて、選択したブックを閉じる動作をしています。
コード
'ブックを開いて開いたページを持ってくるプログラム。
Public Sub BOOKCOPY()
'現在のブックの名前を格納
ReturnFileName = ActiveWorkbook.Name
'エクセルファイルを選択
OpenFileName1 = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", MultiSelect:=True)
'IsArray で配列か確認(2個以上でも対応)
If IsArray(OpenFileName1) Then
'For Each 要素を受け取る変数名 In 配列やコレクションなどのグループ名
For Each OpenFileName In OpenFileName1
'ブックを開く
Workbooks.Open OpenFileName
'ファイルの名前を検索するためにPOSに最後の¥の場所を格納。
'POS+1以降が名前なのでFileNameに格納
'filenameをアクティベイト
POS = InStrRev(OpenFileName, "\")
Filename = Mid(OpenFileName, POS + 1)
Workbooks(Filename).Activate
'***********
'情報の取り出しなどしたかったらここに入力
'アクティブなワークシートをコピーして元のブックに持ってくる。
ActiveSheet.COPY after:=Workbooks(ReturnFileName).ActiveSheet
'***********
'エラーを回避して開いたブックを閉じる。
Application.DisplayAlerts = False
Workbooks(Filename).Close
Application.DisplayAlerts = True
Next OpenFileName
End If
End Sub
ポイントとなるコード
OpenFileName1 = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", MultiSelect:=True)Workbooks.Open OpenFileName
[ファイルを開く]ダイアログボックスを表示するためのコマンドがApplication.GetOpenFilename・”エクセル,*.xlsx,マクロ,*.xlsm,テキスト,.txt"のようにファイルの指定ができます。
・MultiSelect:=True とすると、shiftやctrlで複数選択可能です。(複数の時は配列になる)
・ファイルのフルパスを返す だけなので、そのあとに開く必要があります。
For Each A In Worksheets
すべてのWorksheetsを見ていきます。
1周目 A=sheet1, 2周目 A=sheet2, 3周目 A=sheet3 のような形です。
worksheet形式で返されるので、
worksheets("sheet1").copyのように A.activate A.name などで使います。
'例
Public Sub TEST()
i = 1
For Each A In Worksheets
Cells(i, 1) = A.Name
i = i + 1
Next A
End Sub
Application.DisplayAlerts = False
一時的にアラートを消します。
データを保存しますか?など聞かれるのを消しています。
コメント欄
お世話になります。
まさに自分のやりたいことがそのままでした!
大変参考になる記事でありがたく拝見いたしました。
一点質問なのですが、このコードの場合キャンセルボタンを押したときの処理はどのようにすればよろしいのでしょうか?
いろいろ試しましたがうまくいきませんでした。
ご教授頂けますと幸いです。
If OpenFileName1 = "False" Then Exit Sub
で、いけませんでしょうか??
もしくは、
' ユーザーがキャンセルボタンをクリックした場合の処理
If Not IsArray(OpenFileName1) Then
MsgBox "ファイルの選択がキャンセルされました。", vbExclamation
Exit Sub
End If
でいけるかと?
お世話になります。
素早しご返信ありがとうございます!
前者だと「型が一致しません」でしたが、
後者でバッチリ動きました。
ご教授頂きありがとうございました。