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
解説は後日つけます。
スポンサーリンク
コメント