役に立つか?VBAメモ

仕事で使ったVBAをメモっとく

別のブックを開いてコピーする

ブック間でコピーするのは決まったところに決まったものを貼り付けるとなると一々が面倒です。
開いてコピーして、ペーストするブックをアクティブにして貼り付けて、コピー元閉じて・・・
といっても複数のブックから集計することはママあります。
手っ取り早くVBAでやっちゃいましょう。

 

 

Private Sub CommandButton1_Click()
Dim flag As Boolean
Dim Fdir As String
Dim FPss As String
Dim FileName As String
Dim Opnbook As Workbook
Dim Z As Worksheet
Dim H As Worksheet

'チラついて五月蝿いのを防止
Application.ScreenUpdating = False

Fdir = "C:\Users\ユーザ名\Documents\フォルダ名\"
FPss = Fdir & "開くブック.xlsx"
FileName = FPss

flag = False

'今開いているブックを調べる
For Each Opnbook In Workbooks
If Opnbook.FullName = FileName Then
flag = True
Exit For
End If
Next Opnbook

'目的のブックが開いてなければ開き、名前をセット
If flag = False Then
Set Opnbook = Workbooks.Open(FileName)
End If

'コピー元先のシートをセット
Set Z = Opnbook.Worksheets("sheet1")
Set H = Workbooks("アクティブブック.xlsm").Worksheets("sheet1")

'コピー元をアクティブにする
Opnbook.Activate

'コピペ 今回コピー元セルには計算があると仮定して、値で貼付けとしている
'2箇所コピペすることにしてある
Z.Range("A1:A10").Copy
H.Range("A5").PasteSpecial Paste:=xlValues

Z.Range("A11:A20").Copy
H.Range("B5").PasteSpecial Paste:=xlValues

'コピー元にもよるけど保存するか否かのダイアログがでたりするのでそれは表示させないで閉じる
Application.DisplayAlerts = False
Opnbook.Close

'主たるブックをアクティブにする
Workbooks("アクティブブック.xlsm").Activate
H.Range("A1").Select

End Sub

 

 

 

 

"開くブック.xlsx"をアクティブブックのセル内でリスト化して代入させると複数のコピー元ブックを必要に応じて開くこともできるでしょう。(リスト=ブック1、ブック2、ブック3・・・とか)
その時には貼り付け先も考えてね。上書きされちゃうから。

あと画面の更新時のチラツキは邪魔なんで、”Application.ScreenUpdating = False”と書きました。
チラツキ防止には色々あるようだけど1行で済むので・・・
チラツキはメモリ消費もかなりあるようで、場合によっては、Excelが落ちる原因になってる場合もあります。
別のブックではこの1行で落ちなくなったので、一応は実績有りです。

 

 コレジャナイ