複数のブックにあるデータを集計しなきゃいけないなど、別のブックにあるデータをコピペして使うことがよくあります。
ブックを開いて、コピペして、ブックを閉じて・・・
の繰り返し。
社内文書で毎月上がってくる報告書など、コピー元の書式が変わらないのであればVBAにお任せできちゃうのでサクッと自動化しましょう♪
この記事の最後にサンプルコードが入ったエクセル＆名前取得用のcsvファイルが入ったフォルダがダウンロードできるリンクがありますので、自分でコードを実行してみたい場合はダウンロードしてみてください。
サンプルコード１（超シンプル＆非実用的）
別のブックのデータをコピーするだけであれば、簡単なコードで表せます。
Sub Sample1()
Workbooks("コピー元.xlsx").Worksheets("Sheet1").Range("A1:D5").Copy _
Workbooks("別ブックにコピー.xlsm").Worksheets("Sheet1").Range("A1")
End Subはい、これだけです。
ただ、これだとコピー元のエクセルをあらかじめ開いておく必要があります。
開いてないと、「そんなエクセル無いよ？」ってエラーが出ます。
というわけでコピー元のエクセルを開くコードも追加します。
サンプルコード２（実用的）
Sub Sample2()
Dim FilePath As String
'ファイルの入っているフォルダをパスを設定
FilePath = ThisWorkbook.Path
'コピー元のブックを開く
Workbooks.Open FilePath & "\コピー元.xlsx"
'データをコピー
Workbooks("コピー元.xlsx").Worksheets("Sheet1").Range("A1:D5").Copy _
Workbooks("別ブックにコピー.xlsm").Worksheets("Sheet1").Range("A1")
'コピー元のブックを閉じる(セーブしない)
Workbooks("コピー元.xlsx").Close savechanges:=False
End Subコピー元のブックを開いてから実行するように変更しました。
開く＆閉じるのコードが追加されています。
ブックを開くためにはブックのあるフォルダを指定してあげる必要があります。
お客さんに依頼を受けてVBAを作る場合などは、フォルダ名などが分かりませんので「VBAのファイルと同じフォルダに必要ファイルを入れて実行してください」のようにお願いしています。そうすると、『ThisWorkbook.Path』を使って、ブックがどのフォルダ内に入っているかを特定できます。
開いたブックを閉じるときですが、コピー元のブックは変更せずに閉じたいことが多いので、変更を保存しないで閉じるをしています。
『savechanges:=False』のFalseをTrueに変えると変更を保存して閉じることができます。
サンプルコード３（実用的＆エラーに対処）
もう一段階の改良を入れましょう。
ブックを開く際に、状況によってはエラーがでて実行が止まります。
考えられる状況は２つ。
１．開きたいブックが存在しない
２．既にそのブックを開いている
この状態が発生した時にエラーで止まるのではなく、メッセージを表示して実行を中止するようにしておいたほうが良いです。
作成者本人が使う場合はエラーで止まっても対処できるのでいいのですが、お客様に納品する場合にはそうもいかず。
というわけで、
１．開きたいブックが存在するか
２．同じ名前のブックが開いているか
をチェックしてからブックを開くようにします。
Sub Sample3()
Dim FilePath As String
Dim FileName As String
Dim wb As Workbook
'ファイルの入っているフォルダをパスを設定
FilePath = ThisWorkbook.Path
'ファイル名を設定
FileName = "コピー元.xlsx"
'コピー元のブックが存在するか確認
If Dir(FilePath & "\" & FileName) = "" Then
'コピー元のエクセルが無かったらメッセージを表示してSubを抜ける
MsgBox FileName & "というファイルが存在しません" & vbCrLf & _
"指定のフォルダに該当のファイルを入れて実行し直してください"
Exit Sub
End If
'既に開いているかをチェック
For Each wb In Workbooks
If wb.Name = FileName Then
'既に開いていたらメッセージを表示してSubを抜ける
MsgBox FileName & "は既に開いています"
Exit Sub
End If
Next wb
'コピー元のブックを開く
Workbooks.Open FilePath & "\コピー元.xlsx"
'データをコピー
Workbooks(FileName).Worksheets("Sheet1").Range("A1:D5").Copy _
Workbooks(ThisWorkbook.Name).Worksheets("Sheet1").Range("A1")
'コピー元のブックを閉じる(セーブしない)
Workbooks(FileName).Close savechanges:=False
End Subサンプルコード4（実用的＆エラーに対処）
YouTubeの方で質問があったので、もう１パターンサンプルコードを載せておきます。
サンプルコード3では、コピー元のファイルが既に開いている場合はメッセージを表示して実行をストップするという動きにしていますが、そのままコピーを続行する場合のコードになります。
こちらを実現するために既に開いているかをチェックするFor文に少し手を加えます。
- コピー元のエクセルが開いていなかったらフラグを立てる
- フラグが立っていなかったらコピー元のエクセルを開く
という仕組みにすればOKです。
具体的なコードはこんな感じになります。
Sub Sample4()
Dim FilePath As String
Dim FileName As String
Dim wb As Workbook
Dim OpenFlag As Boolean
'ファイルの入っているフォルダをパスを設定
FilePath = ThisWorkbook.Path
'ファイル名を設定
FileName = "コピー元.xlsx"
'コピー元のブックが存在するか確認
If Dir(FilePath & "\" & FileName) = "" Then
'既に開いていたらメッセージを表示してSubを抜ける
MsgBox FileName & "というファイルが存在しません" & vbCrLf & _
"指定のフォルダに該当のファイルを入れて実行し直してください"
Exit Sub
End If
'既に開いているかをチェック
For Each wb In Workbooks
If wb.Name = FileName Then
'既に開いていたらフラグを立ててfor文を抜ける
OpenFlag = True
Exit For
End If
Next wb
'フラグがFalseだったらコピー元のファイルが開いていないので、開く
If OpenFlag = False Then
'コピー元のブックを開く
Workbooks.Open FilePath & "\コピー元.xlsx"
End If
'データをコピー
Workbooks(FileName).Worksheets("Sheet1").Range("A1:D5").Copy _
Workbooks(ThisWorkbook.Name).Worksheets("Sheet1").Range("A1")
'コピー元のブックを閉じる(セーブしない)
Workbooks(FileName).Close savechanges:=False
End Sub最初は超シンプルでしたが、エラーの処理とか汎用性とかを考えると、どんどんコードが増えてゆきます。表面的な機能だけではなく、裏でコソコソと動く機能も作るので単純な機能でもいろいろ考えることがあって大変ですね。
コードの解説を動画でもしています。１行ずつ実行しながら解説しているので、文字で見るよりわかりやすくなっていると思います。
ぜひ見てみてください。
今回は以上です！この記事がどなたかの参考になれば嬉しいです。
お問い合わせ、お仕事のご依頼などがありましたら下記のお問い合わせフォームからご連絡お願いします。
ダウンロード
ファイルのダウンロードはこちらからどうぞ(^^)/
コメント