[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『別ブックで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.