【VBA】列幅と行高さのみを他シートへコピーする

こんにちは、Ryoです。
Excelで表を作成して運用していると列幅や行高さの調整を行うことが多々ありますが、その設定を他シートへそのまま複製したい場合に通常操作で行うにはやや煩雑なので、VBAを利用して簡単に列幅と行高さのコピーを行う方法について書いていきたいと思います。

1.サンプル概要
2.フォーム／サンプルコード
- ◆UserForm構成
- ◆サンプルコード
3.まとめ

1.サンプル概要

ユーザーフォームを簡易的に作成してSheet4の列幅と行高さをSheet5にコピー、Sheetの列幅と行高さをSheet３にコピーする動作をそれぞれ実行した動画が以下になります。

ユーザーフォーム上にあるコマンドボタンで①と②がありますが、①はコピー先としたSheet５に対してA列と1行目のデータ入力されている最終行までコピー元のSheet4の同じ位置の行高さ／列幅を反映します。なので元としているSheet4側はデータ入力などがなくても動作します。

≪コピー元：Sheet４≫

≪コピー先：Sheet５≫　－実行前－

≪コピー先：Sheet５≫　－実行後－

②はサンプルコード上で50行、50列までの行高さと列幅をコピー先に反映するようにしていますので、予め決められた範囲に対しての処理であれば有効です。

≪コピー元：Sheet2≫

≪コピー先：Sheet３≫　－実行前－

≪コピー先：Sheet３≫　－実行後－

以上がサンプル概要になります。

2.フォーム／サンプルコード

◆UserForm構成

コピー元とコピー先のワークシートをそれぞれ選択するリストボックス1と2、後は処理方法の違いで分けているのでコマンドボタン1と2があります。ラベルは便宜上のものなので有無は任意です。

◆サンプルコード

≪初期化処理≫

Private Sub UserForm_Initialize()
'＊＊＊UserForm1の初期処理＊＊＊

 Dim n As Integer
   'ListBox1と2に対する処理
   For n = 1 To 2
     'ブックのワークシート数をカウントし、その分処理を行う
     For i = 1 To Worksheets.Count
       'ワークシート名をListBox1と2にそれぞれ表示
       Me.Controls("ListBox" & n).AddItem Worksheets(i).Name
     Next i
   Next n

End Sub

UserForm1を表示させる際の初期処理になります。起動する際にブック全体のワークシートをカウントし、その数だけ繰り返し処理を行いながらワークシート名を取得してListBox1とListBox2に反映します。

ListBoxのようなコントロールに対し変数処理をしたい場合、Me.Controls(”ListBox”＆変数）の形で記述すれば可能なので知っておくと便利です。

≪CommandButton1≫

Private Sub CommandButton1_Click()
'＊＊＊行高さ、列幅のみを他シートへコピー＊＊＊

 Dim a, b As String
    'ListBoxで選択されている項目を取得
    a = ListBox1.Text
    b = ListBox2.Text
    
    '未選択や同じシートを選択している場合はエラーメッセージ
    If a = "" Or b = "" Or a = b Then
       MsgBox "選択されていないか、重複しています", vbCritical
       Exit Sub
    End If
    
  Dim c As Long
  Dim d As Long

  'コピー先シートに対する処理
  With Worksheets(b)
    'A列に対し入力されている最終行までの行高さを順次取得し、
    'コピー先シートの行へ反映する
    For c = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
        .Rows(c).RowHeight = Worksheets(a).Rows(c).RowHeight
    Next c

    '1行目に対し入力されている最終列までの列幅を順次取得し、
    'コピー先シートの列に反映する
    For d = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
        .Columns(d).ColumnWidth = Worksheets(a).Columns(d).ColumnWidth
    Next d
  End With
End Sub

ListBox上でコピー元とコピー先のSheetをそれぞれ選択した上で処理を実行するので、それぞれ選択されたシート名を変数a,bに格納しますがシート名が重複している場合や未選択時はエラーメッセージを表示して処理を終了させます。

次にコピー先シートへ行高さや列幅をコピーしていきます。コピー先のシートに対し行は .Cells(Rows.Count, “A”).End(xlUp).RowでA列に対する最終行まで、列は.Cells(1, Columns.Count).End(xlToLeft).Columnで1行目に対する最終列までを対象とさせています。

後はそれぞれの行や列に対してコピー元の設定を反映しています。

≪CommandButton2≫

Private Sub CommandButton2_Click()

Dim a, b As String
    a = ListBox1.Text
    b = ListBox2.Text
    If a = "" Or b = "" Or a = b Then
       MsgBox "選択されていないか、重複しています", vbCritical
       Exit Sub
    End If
    
  Dim c As Long
  Dim d As Long

  With Worksheets(b)
    '行高さの複製範囲を限定（サンプルでは50行目まで）
    For c = 1 To 50
        .Rows(c).RowHeight = Worksheets(a).Rows(c).RowHeight
    Next c

    '列幅の複製範囲を限定（サンプルでは50列目まで）
    For d = 1 To 50
        .Columns(d).ColumnWidth = Worksheets(a).Columns(d).ColumnWidth
    Next d

    '※　最終行検出の場合は入力済みであることが前提になるので、
    '　　セルの入力有無に関わらず行高さや列幅を複製したい場合は範囲を指定すれば可

  End With

End Sub

基本的な流れはコマンドボタン1と同様ですが、こちらは行や列の指定した範囲をコピー先に反映するようにしているのでサンプルコードでは50行／50列の範囲を指定しています。

範囲を限定しても特に問題ないようであれば、この形の方が使い勝手は良いように思います。