Excel VBA ファイルを開いてデータを貼り付ける

EXCEL

Sub CopyFromAnotherWorkbook()
‘ 変数の宣言
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim FilePath As String
Dim sheetExists As Boolean
Dim ws As Worksheet

‘ Sheet2が存在するか確認
sheetExists = False
For Each ws In ThisWorkbook.Sheets
If ws.Name = “Sheet2” Then
sheetExists = True
Set wsDest = ws
Exit For
End If
Next ws

‘ Sheet2が存在する場合はデータをクリア
If sheetExists Then
wsDest.Cells.Clear
Else
‘ Sheet2が存在しない場合は作成
Set wsDest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsDest.Name = “Sheet2”
End If

‘ ファイルを選択して開くダイアログを表示
FilePath = Application.GetOpenFilename(“Excelファイル (*.xlsx), *.xlsx”, , “コピー元のファイルを選択してください”)

‘ キャンセルされた場合は作成したSheet2を削除して処理を中止
If FilePath = “False” Then
If Not sheetExists Then
Application.DisplayAlerts = False
wsDest.Delete
Application.DisplayAlerts = True
End If
Exit Sub
End If

‘ 選択したファイルを開く
Set wbSource = Workbooks.Open(FilePath)

‘ コピー元のワークシートを指定
On Error Resume Next
Set wsSource = wbSource.Sheets(“Sheet1”)
On Error GoTo 0

‘ コピー元のSheet1が存在しない場合はSheet2を削除して処理を中止
If wsSource Is Nothing Then
If Not sheetExists Then
Application.DisplayAlerts = False
wsDest.Delete
Application.DisplayAlerts = True
End If
wbSource.Close SaveChanges:=False
MsgBox “コピー元のシートが存在しませんでした。処理を中止します。”, vbExclamation
Exit Sub
End If

‘ 範囲B2:F4をコピー
wsSource.Range(“B2:F4”).Copy

‘ Sheet2のA1に貼り付け(値だけ)
wsDest.Range(“A1”).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False ‘ コピーの選択状態を解除

‘ コピー元のファイルを閉じる
wbSource.Close SaveChanges:=False

MsgBox “コピーが完了しました!”, vbInformation
End Sub

解説は後日つけます。

スポンサーリンク

コメント

タイトルとURLをコピーしました