VBAで別ワークブックのワークシートからのテキスト転記する

別のワークブックよりコード等のテキストを転記したい場合、コピー＆ペーストで対応できますが作業量が多いと大変です。このような作業をVBAを利用して作業を楽にする方法を紹介します。仕組みは単純です。

テキスト転記の例

入力するコード等の文字が長かったり、複雑な場合間違えないように、そして早く楽に入力したいときの例です。

転記機能がない場合

シート「取引」のC列にコードを入力すると、右隣のシート「取引先」のデータを参照しD列に取引先を表示する例です。D列にはVLOOKUP関数が入力されています。

シート「取引先」からコードを検索してコードをコピーすると大変です。

転記機能のある例

シート「取引先」を別のワークブックで簡単に抽出できるワークシートを作り、抽出した結果のテキストを転記する方法です。

「別のワークブックで簡単に抽出できるワークシート」は、以下の別記事で紹介しています。

別ブックにする理由：転記先のブックは、マクロ有効ブックではなく複数あるため

• 青枠：マクロ機能なし（マクロ有効ブックではない）、別ブック（赤枠）からコードを転記
• 赤枠：マクロ有効ブック

（1）ワークブック「sample.xlsx」のシート「取引」のセルC2をクリックし、Alt　+　F８でマクロを呼び出し実行します。もしくはショートカットキーを割り当てる方法もあり。

実行結果です。

ワークブック「取引先転記.xlsm」のシート「取引先」を表示します。

（2）ワークブック「取引先転記.xlsm」のシート「取引先」でデータを抽出し、該当のコードのセルをクリック後、コマンドボタン「転記」をクリックします。

結果です。

転記先の「sample.xlsm」を表示し、セルC2にコードを転記します。

VBAで転記するサンプル

VBAのコードは「取引先転記.xlsm」にあります。場所は2カ所です。

• 転記先シートよりマクロを呼び出した時：標準モジュール
• コマンドボタン「取引」をクリックした時：Sheet1(取引先)

転記先シートよりマクロを呼び出した時

標準モジュールにコードを入力します。

Sub tenkisaki()
 Dim aWb As String
 Dim aWs As String
 Dim aCell As String

 aWb = ActiveWorkbook.Name
 aWs = ActiveSheet.Name
 aCell = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
 
        With Workbooks("取引先転記.xlsm").Sheets("取引先")
            .Range("A1") = aWb
            .Range("B1") = aWs
            .Range("C1") = aCell
            .Activate
        End With
            ActiveWindow.WindowState = xlMaximized    
End Sub

参考：1～８行目は、次のようにまとめるとスッキリします。

 Dim aWb As String: aWb = ActiveWorkbook.Name
 Dim aWs As String: aWs = ActiveSheet.Name
 Dim aCell As String: aCell = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)

コマンドボタン「転記」をクリックした時

Sheet1（取引先）に直接コードを入力する方法です。他の方法もあります。

Private Sub Cmd3_Click()
    
    Dim aCell As String
    Dim mWb As String, mWs As String, mWh As String, mCell As String
    
    mWb = Range("A1")
    mWs = Range("B1")
    mCell = Range("C1")

    If mWb = "" Or mWs = "" Or mCell = "" Then
        MsgBox "転記先の指定がありません", vbExclamation, Title:="転記先"
        Exit Sub
    End If
    
    aCell = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    
    Range("A1:C1").ClearContents
    
    With Workbooks(mWb).Sheets(mWs)
        .Range(mCell) = Range(aCell)
        .Activate
    End With
    
End Sub