●　Excel マクロの解説 「 転記マクロ 」編　●

「 自動転記マクロ 」について、簡単ですが赤字で解説を入れました。
参考になれば、幸いです。

 2019.11.07 現在
-----------------------------------------------------------

thisWorkbook のプログラム

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    SAA02リセット
End Sub
Sub auto_open()は、下記が実行されてから、実行されます。
アドインメニューの表示
Private Sub Workbook_Open()

SAA02セット

End Sub

------------------------------------------------------------

UForm1 のプログラム

Private Sub CommandButton1_Click()    <-- [読　込] ボタンの処理
    ' [ マクロの表紙]へブック名・シート名保存
 F1name = ActiveWorkbook.Name
 R1name = ActiveSheet.Name
 Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value = _
  F1name
 Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value = _
  R1name

    データ読込
End Sub

Private Sub CommandButton2_Click()    <-- [書　込] ボタンの処理
 ' [ マクロの表紙]へブック名・シート名保存
 F2name = ActiveWorkbook.Name
 R2name = ActiveSheet.Name
 Workbooks(AAname).Worksheets(BBname).Cells(21, 2).Value = _
  F2name
 Workbooks(AAname).Worksheets(BBname).Cells(21, 3).Value = _
  R2name

    データ書込
End Sub

Private Sub CommandButton7_Click()    <-- [読込元] ボタンの処理
 ' [ マクロの表紙]へブック名・シート名保存
 F1name = ActiveWorkbook.Name
 R1name = ActiveSheet.Name
 Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value = _
  F1name
 Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value = _
  R1name
 '  [選択された範囲の縦先頭位置を取得
 YY = ActiveWindow.Selection(1).Row
 '  [縦範囲 セル個数を取得
 YC = ActiveWindow.Selection.Rows.Count
 '  [選択された範囲の横先頭位置を取得
 XX = ActiveWindow.Selection(1).Column 

 Workbooks(AAname).Worksheets(BBname).Cells(24, 2).Value = YY
 Workbooks(AAname).Worksheets(BBname).Cells(24, 3).Value = XX
 Workbooks(AAname).Worksheets(BBname).Cells(25, 2).Value = YC
    
End Sub

Private Sub CommandButton8_Click()   <-- [書込先] ボタンの処理
 ' [ マクロの表紙]へブック名・シート名保存
 F2name = ActiveWorkbook.Name
 R2name = ActiveSheet.Name
 Workbooks(AAname).Worksheets(BBname).Cells(21, 2).Value = _
  F2name
 Workbooks(AAname).Worksheets(BBname).Cells(21, 3).Value = _
  R2name
 '  選択された範囲の縦先頭位置を取得
 Workbooks(AAname).Worksheets(BBname).Cells(28, 2).Value _
         = ActiveWindow.Selection(1).Row
 
 自動データ転記1

End Sub

Private Sub CommandButton9_Click()  <-- [分割表示] ボタンの処理
    ' 分割表示
    Windows.Arrange ArrangeStyle:=xlVertical <-- 左右分割表示
    
End Sub

Private Sub CommandButton9_Click() <-- [分割表示] ボタンの処理・
                                          分割有／無を切り替える
'[マクロの表紙]のセル位置(22,2)を分割表示の有無スイッチとして使う
 ' 分割表示/分割解除
 If Workbooks(AAname).Worksheets(BBname).Cells(22, 2).Value = 0 _
  Then _
   Workbooks(AAname).Worksheets(BBname).Cells(22, 2).Value = 1

     UForm1.CommandButton9.Caption = "分割解除"
     '全画面で、横方向に並べて表示
     'Windows.Arrange ArrangeStyle:=xlVertical  <-- 左右分割表示
     Windows.Arrange xlArrangeStyleVertical
  Else
     Workbooks(AAname).Worksheets(BBname).Cells(22, 2).Value = 0
     '  表示を最大化し、元に戻す
     Application.WindowState = xlMaximized
     UForm1.CommandButton9.Caption = "分割表示"
  End If

End Sub

    'ここからは、逆方向への転記処理をする処理

Private Sub CommandButton10_Click()  <-- [ 読込元] ボタンの処理
 ' [ マクロの表紙]へブック名・シート名保存
 F2name = ActiveWorkbook.Name
 R2name = ActiveSheet.Name
 Workbooks(AAname).Worksheets(BBname).Cells(21, 2).Value = _
  F2name
 Workbooks(AAname).Worksheets(BBname).Cells(21, 3).Value = _
  R2name
 Workbooks(AAname).Worksheets(BBname).Cells(28, 2).Value _
      = ActiveWindow.Selection(1).Row           ' 縦先頭位置

 自動データ転記2
    
End Sub

Private Sub CommandButton11_Click() <-- [ 書込先 ] ボタンの処理
 ' [ マクロの表紙]へブック名・シート名保存
 F1name = ActiveWorkbook.Name
 R1name = ActiveSheet.Name
 Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value = _
  F1name
 Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value = _
  R1name
 
 YY = ActiveWindow.Selection(1).Row           ' 縦先頭位置
 YC = ActiveWindow.Selection.Rows.Count       ' 縦範囲 セル個数
 XX = ActiveWindow.Selection(1).Column        ' 横先頭位置
 XC = ActiveWindow.Selection.Columns.Count    ' 横範囲 セル個数

 Workbooks(AAname).Worksheets(BBname).Cells(24, 2).Value = YY
 Workbooks(AAname).Worksheets(BBname).Cells(24, 3).Value = XX
 Workbooks(AAname).Worksheets(BBname).Cells(25, 2).Value = YC

End Sub

Private Sub UserForm_Initialize()
 '  ユーザーフォームを表示したブック名を保存
 Workbooks(AAname).Worksheets(BBname).Cells(18, 2).Value = _
   ActiveWorkbook.Name
 Workbooks(AAname).Worksheets(BBname).Cells(18, 3).Value = _
   ActiveSheet.Name
 
 Workbooks(AAname).Worksheets(BBname).Cells(22, 2).Value = 0
 UForm1.CommandButton9.Caption = "分割表示"
  
End Sub

------------------------------------------------------------------
Module1 のプログラム

    Public x, y, Tate, Yoko As Integer
    Public M, MM, N, YY, YC, XX, XC, KYY As Integer
    ' N の値を変えると読み書きのデータ数が変更できます。
    Public Const NN As Integer = 11       <---- 転記可能セルの最大数
    ' 本マクロのブック名 変更しないこと
    Public Const AAname As String = "転記マクロ.xlsm"
    Public Const BBname As String = "表紙
    Public AAA, BBB, CCC, F1name, R1name As String
    Public F2name, R2name As String
    Public StartDay, EndDay, YX_ichi As String
' 読取・書込用変数は、すべての型式に対応させるため、
Variant にしています。
    Public Rdata(20) As Variant

Excelブックがオープンし、マクロが実行された時に自動で実行される
サブルーチン

Sub auto_open()
    '----------------------------------------------------
    ' Excel 起動時にメニューバーをアドインに移動させる処理
    '----------------------------------------------------

    この様にしないといつまでも Excelブックがオープンしない
    '  タイムディレー処理   直ぐに、サブルーチン AddIN を実行させる
    Application.OnTime Now + TimeValue("00:00:00"), "AddIN"
End Sub

------------------------------------------------------------------

メニューバーを「アドイン」に移動させる処理
Sub AddIN()
    Sheets(CCname).Select         <---- 所定のシートを表示させる
    N = Val(Application.Version)  <---- Excelのバージョンを取得する
     
    Excelのバージョンの"2000 ; 9","2002 ; 10","2003 ; 11"時は、
    何もしない
    If N = 9 Or N = 10 Or N = 11 Then Exit Sub
    
    Excelのバージョンの"2007 ; 12","2010 ; 14","2013 ; 15","2016 ; _
    16"時は、アドインに移動
    '  [ALT]-->[X]-->[ALT]のキー入力を実行
    Application.SendKeys ("%X%") 
     '------------------------------------------------------------
     〇〇〇〇に文字を書込むとタイトルの
     MicrosoftExcelの文字が入れ替わります。
     Application.Caption = " 〇〇〇〇"
     '------------------------------------------------------------
End Sub

Sub UForm1表示()
    UForm1.Show vbModeless  <---- ユーザーフォーム UForm1 を表示する
End Sub

Sub SAA02セット()     <---- アドインメニューを表示する。
     Dim Mycontrol As CommandBarControl
     Dim mysubmenu As CommandBarControl
     '  事前にアドインメニューを消去する。
     Application.CommandBars("Worksheet Menu Bar").Reset
     Set Mycontrol = CommandBars("Worksheet Menu Bar"). _
     Controls.Add(msoControlPopup)
     Mycontrol.Caption = "(■)"
     Mycontrol.OnAction = "UForm1表示"
End Sub

Sub SAA02リセット()
 '  すべてのアドインメニューを消去する。
 Application.CommandBars("Worksheet Menu Bar").Reset 
 ' ブック名・シート名保存場所リセット
 Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value = ""
 Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value = ""
 Workbooks(AAname).Worksheets(BBname).Cells(21, 2).Value = ""
 Workbooks(AAname).Worksheets(BBname).Cells(21, 3).Value = ""
End Sub

Sub データ読込()
 ' ブック名・シート名復旧
 F1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value
 R1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value


 For N = 1 To NN      ' NN : 読取・書込データ数
 
    R_ichi  ' 読込み位置 y, x 取得
    ' 指定が無かったら終了
    If x = 0 Then Exit For

 Rdata(N) = _
  Workbooks(F1name).Worksheets(R1name).Cells(y, x).Value

 Next N
    ' ユーザーフォーム上に読込んだデータの一部を表示する。
 UForm1.Label3.Caption = Rdata(1) & " " & Rdata(2) & " " & Rdata(3)
        
End Sub

Sub R_ichi()

 y = ActiveWindow.RangeSelection.Rows.Row
 x = _
  Workbooks(AAname).Worksheets(BBname).Cells(3, 10 + N).Value
    
End Sub

------------------------------------------------------------------

Sub データ書込()
 ' ブック名・シート名復旧
 F1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value
 R1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value

 For N = 1 To NN      ' NN : 読取・書込データ数
 
    W_ichi  ' 書込み位置 y, x 取得
    
    ' 指定が無かったら終了
    
  If x = 0 Then Exit For
    
  Workbooks(F2name).Worksheets(R2name).Cells(y, x).Value = Rdata(N)
        
 Next N
    
End Sub

Sub W_ichi()

 y = ActiveWindow.RangeSelection.Rows.Row
 x = Workbooks(AAname).Worksheets(BBname).Cells(4, 10 + N).Value
    
End Sub

    '----------------------------------------------------
'     指定した範囲のデータを自動ですべて転記する。
    '----------------------------------------------------

Sub 自動データ転記1()
 ' ブック名・シート名復旧
 F1name = _
   Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value
 R1name = _
   Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value
 Workbooks(F1name).Activate
 Worksheets(R1name).Activate
 ' ユーザーフォームからフォーカス（アクティブ）をブックに移す処理
 VBA.AppActivate Excel.Application.Caption
    
 ' 抽出データの最終行を検索する。
 YY = Workbooks(AAname).Worksheets(BBname).Cells(24, 2).Value
 M = Workbooks(AAname).Worksheets(BBname).Cells(25, 2).Value
 KYY = Workbooks(AAname).Worksheets(BBname).Cells(28, 2).Value
    
 For MM = 1 To M      ' NN : 読取・書込データ数
 
    y = YY         ' 読込先縦位置指定
 
    自動データ読込1
    自動データ書込1

    KYY = KYY + 1      ' 書込先縦位置更新
    YY = YY + 1        ' 読込先縦位置更新

 Next MM
    
End Sub

Sub 自動データ読込1()

 F1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value
 R1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value
 Workbooks(F1name).Activate
 Worksheets(R1name).Activate
 ' ユーザーフォームからフォーカス（アクティブ）をブックに移す処理
 VBA.AppActivate Excel.Application.Caption
 
 For N = 1 To NN          ' NN : 読取・書込データ数
 
  x = Workbooks(AAname).Worksheets(BBname).Cells(3, 10 + N).Value
 
  ' 指定が無かったら終了
    If x = 0 Then Exit For

  Rdata(N) = _
    Workbooks(F1name).Worksheets(R1name).Cells(y, x).Value
 
 Next N
        
End Sub

Sub 自動データ書込1()

 F2name = _
  Workbooks(AAname).Worksheets(BBname).Cells(21, 2).Value
 R2name = _
  Workbooks(AAname).Worksheets(BBname).Cells(21, 3).Value
 Workbooks(F2name).Activate
 Worksheets(R2name).Activate
 ' ユーザーフォームからフォーカス（アクティブ）をブックに移す処理
 VBA.AppActivate Excel.Application.Caption
 
 For N = 1 To NN          ' NN : 読取・書込データ数
 
    x = _
 Val(Workbooks(AAname).Worksheets(BBname).Cells(4, 10 + N).Value)
 
    ' 指定が無かったら終了
 
  If x = 0 Then Exit For
 
 Workbooks(F2name).Worksheets(R2name).Cells(KYY, x).Value = Rdata(N)

 Next N
    
End Sub

-----------------------------------------------------------------
'------------------------------------------------------------------
'指定した範囲のデータを自動ですべて転記する。(上記の逆位置への転記)
'------------------------------------------------------------------

Sub 自動データ転記2()

 ' 書込み側の位置情報で読込・読込側の位置情報で書き込む
 F1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value
 R1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value
 Workbooks(F1name).Activate
 Worksheets(R1name).Activate
 ' ユーザーフォームからフォーカス（アクティブ）をブックに移す処理
 VBA.AppActivate Excel.Application.Caption
 
 ' 抽出データの最終行を検索する。
 YY = Workbooks(AAname).Worksheets(BBname).Cells(24, 2).Value
 M = Workbooks(AAname).Worksheets(BBname).Cells(25, 2).Value
 KYY = Workbooks(AAname).Worksheets(BBname).Cells(28, 2).Value
 
 For MM = 1 To M
 
    y = YY         ' 読込先縦位置指定
 
    自動データ読込2
    自動データ書込2

    KYY = KYY + 1      ' 書込先縦位置更新
    YY = YY + 1        ' 読込先縦位置更新
        
 Next MM
    
End Sub

Sub 自動データ読込2()

 F1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 2).Value
 R1name = _
  Workbooks(AAname).Worksheets(BBname).Cells(20, 3).Value
 Workbooks(F1name).Activate
 Worksheets(R1name).Activate
 ' ユーザーフォームからフォーカス（アクティブ）をブックに移す処理
 VBA.AppActivate Excel.Application.Caption
 
 For N = 1 To NN          ' NN : 読取・書込データ数
 
    x = _
     Workbooks(AAname).Worksheets(BBname).Cells(4, 10 + N).Value
 
    ' 指定が無かったら終了
    If x = 0 Then Exit For

    Rdata(N) = _
     Workbooks(F1name).Worksheets(R1name).Cells(y, x).Value

 Next N
        
End Sub

Sub 自動データ書込2()

 F2name = _
  Workbooks(AAname).Worksheets(BBname).Cells(21, 2).Value
 R2name = _
  Workbooks(AAname).Worksheets(BBname).Cells(21, 3).Value
 Workbooks(F2name).Activate
 Worksheets(R2name).Activate
 ' ユーザーフォームからフォーカス（アクティブ）をブックに移す処理
 VBA.AppActivate Excel.Application.Caption
 
 For N = 1 To NN      ' NN : 読取・書込データ数
 
 x = _
 Val(Workbooks(AAname).Worksheets(BBname).Cells(3, 10 + N).Value)
 
    ' 指定が無かったら終了
 
    If x = 0 Then Exit For
 
 Workbooks(F2name).Worksheets(R2name).Cells(KYY, x).Value = Rdata(N)

 Next N
    
End Sub

-----------------------------------------------------------