<スポンサーリンク>

選択したブックのシートをコピー~データ集計業務に即したマクロVBA

マクロVBA
この記事は約4分で読めます。
コピーボタン
記事のタイトルとURLをコピー
<スポンサーリンク>

必要なところをコピーして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

一時的にアラートを消します。
データを保存しますか?など聞かれるのを消しています。

コピーボタン
記事のタイトルとURLをコピー
マクロVBA
スポンサーリンク
スポンサーリンク
nujonoaをフォローする

コメント欄

  1. お世話になります。
    まさに自分のやりたいことがそのままでした!
    大変参考になる記事でありがたく拝見いたしました。
    一点質問なのですが、このコードの場合キャンセルボタンを押したときの処理はどのようにすればよろしいのでしょうか?
    いろいろ試しましたがうまくいきませんでした。
    ご教授頂けますと幸いです。

    • If OpenFileName1 = "False" Then Exit Sub

      で、いけませんでしょうか??
      もしくは、

      ' ユーザーがキャンセルボタンをクリックした場合の処理
      If Not IsArray(OpenFileName1) Then
      MsgBox "ファイルの選択がキャンセルされました。", vbExclamation
      Exit Sub
      End If

      でいけるかと?

  2. お世話になります。
    素早しご返信ありがとうございます!
    前者だと「型が一致しません」でしたが、
    後者でバッチリ動きました。
    ご教授頂きありがとうございました。

<スポンサーリンク>
タイトルとURLをコピーしました