Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Pro : Microsoft 365)
別ファイルのアクティブセルの値を貼り付けについて
投稿日時: 25/07/15 15:11:11
投稿者: えっくん

皆さん お世話になります。
 
マクロファイル(A.xlsm)のSheet1(A1,A2,A3セル)に参照元Excelファイル(B.xlsx)のアクティブセルA*とB*、I*のセル値を貼り付けたい と考えています。
 
参照元Excelファイル名はデスクトップにあってB.xlsxで固定です。開いています。これ以外のexcelファイルは開いていません。
アクティブセルのシート名は一日の作業では変わりませんが、日が変わると変わります。
アクティブセルの位置はA列にありますが、行は不定です。都度作業者が設定してからマクロファイルに戻ってマクロボタンを押すことでB.xlsxのA*、B*、I*セル値をマクロファイル(A.xlsm)のSheet1(A1,A2,A3セル)に張り付けたい と考えています。
 
マクロ自体の開発が難しいので、まずは記録をしてみました。
Sub Macro3()
' Windows("B.xlsx").Activate
    Range("A1").Select   'どうやってアクティブセルを選択するのか。
    Selection.Copy
    Windows("A.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("B.xlsx").Activate
    Range("B1").Select 'どうやってアクティブセルから1つ右のセルを選択するのか。
    Application.CutCopyMode = False
    Selection.Copy
    Windows("A.xlsm").Activate
    Range("B1").Select
    ActiveSheet.Paste
    Windows("B.xlsx").Activate
    Range("I1").Select 'どうやってアクティブセルから8つ右のセルを選択するのか。
    Application.CutCopyMode = False
    Selection.Copy
    Windows("A.xlsm").Activate
    Range("C1").Select
    ActiveSheet.Paste
End Sub
都度Excelファイルが切り替わって見苦しいのですが、上記コメント部分を作成すればとりあえずの目的は達成できると思うのですが、どのような記述になるのか教えていただけないでしょうか。
 
できれば一度にB.xlsxのA*,B*I*の値をコピーしてA.xlsmのA1:C1に張り付けられると画面切り替えも少ないと思いますので、この場合の記述も教えていただけると嬉しいです。
 
よろしくお願いします。
 

投稿日時: 25/07/15 16:44:37
投稿者: えっくん

下記の構文でとりあえずB.xlsxのアクティブセルの値をマクロファイルのDheet1のA1セルに張り付けることができました。
 
Sub アクティブセルコピー()
    Dim sourceValue As Variant
    Dim targetSheet As Worksheet
    Windows("B.xlsx").Activate
 
    ' アクティブセルの値を取得
    sourceValue = ActiveCell.Value
 
    ' 貼り付け先のシートを指定(例: "Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
 
    ' 貼り付け先のセルを指定(例: A1)
    targetSheet.Range("A1").Value = sourceValue
End Sub
 

回答
投稿日時: 25/07/15 22:44:30
投稿者: simple

こういうことですか?
 

Sub test()
    Dim ws As Worksheet
    Dim r As Long
    Dim rng As Range
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Workbooks("B.xlsx").Activate
    r = ActiveCell.Row
    Set rng = Union(Cells(r, "A").Resize(1, 2), Cells(r, "I"))
    rng.Copy
    ws.Range("A1").PasteSpecial   Paste:=xlPasteValues, Transpose:=True
    Application.Goto ws.[A1]        '元の位置に戻るなら
End Sub

# 個人的には、アクティブセルに依存した作業は却って神経を使うような気がします。

投稿日時: 25/07/16 08:50:57
投稿者: えっくん

simpleさん
 
コードありがとうございます。試してみました。
B.xlsxのアクティブセル(A*)から所望の3個のセルのコピーがA1:A3に入ることを確認できました。
A1:C1に入れるために下記のコマンドをA1:C1に入れるために
    ws.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=False
とすることで目的の動きを実現することができました。
 
ただ、B.xlsxのコピー元セルが選択されたままの状態です。この選択された状態を解除して
元のA*セルを選択した状態に戻すことは可能でしょうか。
申し訳ありませんがもう少しお付き合いをお願いします。
提示されたコードは勉強します。
 

回答
投稿日時: 25/07/16 10:32:30
投稿者: simple

 ウーム、なぜ転置してしまったのか今となっては不明です。白昼夢でしたか。
 まず最初に追加質問への回答から。
 「この選択された状態を解除して」は、
 貼り付けたあとに、

     Application.CutCopyMode = False
 を入れるとよいでしょう。
  
  以下は、再質問を読む前に書いておいたものに、貼り付け部分の修正をしたものです。
【訂正】
  説明も無しに、[A1]という書き方をしたので戸惑ったかもしれません。
    Application.Goto ws.[A1] 
 は、
    Application.Goto ws.Range("A1")
 と書くのと同じです。
   なお、これはBookをアクティブにし、シートをアクティブにし、セルを選択する動作を、
  1文ですますものです。(決まり文句(jargon)のようなものと思って下さい)
 
【補足1】
  普通は下記のようにBookをアクティベイトします。しかし、画面がちらつきます。
      wb.Activate
       r = ActiveCell.Row
 Application.ScreenUpdating = False などとして 画面更新抑止してもちらつきます。
  これをちらつかないようにするには、下記のようにするといいでしょう。
  r = wb.Windows(1).ActiveCell.Row

【補足2】
  転記元セルは、
  Set rng = Union(Cells(r, "A").Resize(1, 2), Cells(r, "I"))
 としましたが、これは
  Set rng = Rows(r).Range("A1:B1,I1")
 とも書けます。
  まず行を指定して、それに対して相対参照的にRange("A1:B1,I1")と続ければOKです。
   
  このあたりはマクロ記録を一行単位でそのままコードにするという思考は勧められません。
  マクロ記録ですべてができる、と考えないほうがよいと思います。
  もちろん、あらゆるメソッドやプロパティを覚えている人はいないので、
  適宜マクロ記録を参照しますが、部分的に参考にすることが一般的です。
  この辺の見極めが、VBAに慣れるということです。
 
  以上を纏めると下記のようになります。
Sub testその2()
    Dim ws  As Worksheet
    Dim wb  As Workbook
    Dim r   As Long
    Dim rng As Range

    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set wb = Workbooks("B.xlsx")

    r = wb.Windows(1).ActiveCell.Row
    With wb.Sheets(1)
        Set rng = .Rows(r).Range("A1:B1,I1")
    End With
    
    rng.Copy
    ws.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    Application.Goto ws.Range("A1")        '元の位置に戻る
    Application.ScreenUpdating = True
End Sub

 
以下が一番言いたいことなんですが、余りActiveCellに依拠しないほうがよいと思います。
シートから離れるときに、どのセルをアクティブにしていたかを意識している人は少ないと思います。
# 意識しすぎて”常にA1セルに戻すのを習慣にしている”という記事を見たことがあります。
ActiveCellを基準にしてデータを取得すると、思わぬものを取ってくることもあります。
 
そこは、意図的にユーザーに選択させたほうがよいでしょう。
その場合は、ApplicationのInputBoxメソッドを使って下さい。
https://www.moug.net/tech/exvba/0050045.html
が参考になるでしょう。
(なお、InputBox関数というのもあります。これとは別のものなので注意。)
 
Sub testその3()
    Dim ws  As Worksheet
    Dim wb  As Workbook
    Dim r   As Long
    Dim rng As Range
    Dim sourceRng As Range
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set wb = Workbooks("B.xlsx")

    Application.Goto wb.Sheets("sheet1").Range("A1")
    Set rng = Application.InputBox("転記したいデータがある行のセル(列は任意)を選択", Type:=8)
    Set sourceRng = rng.EntireRow.Range("A1:B1,I1")

    sourceRng.Copy
    ws.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    Application.Goto ws.Range("A1") 
End Sub

投稿日時: 25/07/16 17:13:13
投稿者: えっくん

simpleさん
色々とアドバイスありがとうございます。
 
確かにアクティブセルからのコピーは操作間違いを起こす可能性がありますね。
 
投稿日時: 25/07/16 08:50:57の状態で運用して問題が出てくれば更に検討します。
その時はsimpleさんのコードを参照に頑張ってみます。
 
とりあえず解決済みとさせていただきます。
ありがとうございました。