[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『別ブックで2つの別ブックを操作する。』(のむじゅん)
先日は、はじめての御質問にも関わらず、ご回答頂きました皆様、ありがとうございました。その後、皆様からのご回答を元に、自分でも学習をして、無事にやりたいことが出来るようになりました。本当に有難うございました。
今回は、出来るか?否か?を御伺いしたく、書き込みをさせて頂きました。
(出来る場合、ヒント等頂けましたら、有難いです。続きは、自分で努力してみたいと思いますので。)
AとBと言う2つのブックがあります。
ブックAのシート2の内容をブックBのシート5にVBAを利用してコピーがしたいのです。
そして、その際、VBAのボタン等は、ブックCにおきたいのです。
簡単に書きますと、ブックCにあるVBAで、ブックAとブックBを動かせないかな?
と言うことになります。
何卒宜しくお願い致します。
< 使用 Excel:Microsoft365、使用 OS:unknown >
できるけど、運用上やめたほうが良い案件かと思います。 Bにコードがある状態がベターな気がするんですけどねぇ。 事情があればお伺いしますよ (稲葉) 2023/02/13(月) 16:00:03
例えば↓はどのブックに書こうが、hogeブックの1番目のシートのA1セルに書き込みます。(hoge.xlsというブックが開いてないとダメですが)
Sub 実験用()
Workbooks("hoge.xls").Worksheets(1).Range("A1").Value = "hogeブックの1番目のシートのA1セルです"
End Sub
(もこな2) 2023/02/13(月) 16:03:20
ヒントになるかわからないですが、こんな感じで
Option Explicit
Sub test()
Dim wbA As Workbook, wsA As Worksheet
Dim wbB As Workbook, wsB As Worksheet
Dim msg As String
Const wbAPath = "C:\test\a.xlsm"
Const wbBPath = "C:\test\b.xlsm"
'
'エラー処理
'ブックの存在チェック
Set wbA = GetWorkBook(wbAPath, msg)
Set wbB = GetWorkBook(wbBPath, msg)
If wbA Is Nothing Or wbB Is Nothing Then
msg = "ブックが次の理由で開けませんでした。" & vbCrLf & _
msg
GoTo err
End If
'シートの存在チェック
On Error Resume Next
Set wsA = wbA.Sheets("Sheet2")
Set wsB = wbB.Sheets("Sheet5")
If err.Number > 0 Then
msg = "シートが存在しません"
GoTo err
End If
On Error GoTo 0
'
'コピー開始
With wsB
'過去データのクリア
.Cells.ClearContents
'新規データのコピー
.Range("A1").Value = wsA.Range("A1").Value
End With
'
'ブックを閉じる
wbA.Close savechanges:=False 'Aはコピー元なので、保存しないで閉じる
wbB.Close savechanges:=True 'Bはコピー先なので、保存して閉じる(または何もしない)
MsgBox "コピーが完了しました"
Exit Sub
err:
'エラー時のメッセージ
MsgBox msg & vbCrLf & "処理を中断します"
End Sub
Function GetWorkBook(wbPath As String, ByRef msg As String) As Workbook
Dim wbName As String
Dim tmpWB As Workbook
wbName = Dir(wbPath)
If wbName = "" Then
msg = "パスが正しくありません"
Exit Function
End If
On Error Resume Next
Set tmpWB = Workbooks(wbName)
On Error GoTo 0
If tmpWB Is Nothing Then
Set tmpWB = Workbooks.Open(wbPath)
ElseIf tmpWB.ReadOnly = True Then
msg = wbName & "が読み取り専用で開かれています"
Exit Function
End If
Set GetWorkBook = tmpWB
End Function
(稲葉) 2023/02/13(月) 17:26:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.