エクセルでコピーして貼り付けを行うと、通常の方法では列幅や行幅（以下、行の高さ）はコピーされません。
ですが、列幅や行の高さもまとめてコピペしたいという場面は多いかと思います。
この記事では、VBAで列幅と行の高さを保持したままをコピーして貼り付ける方法について紹介します。
VBAで特定の範囲をコピーして貼り付ける
コピーしたい範囲と貼り付けたい範囲を指定して、コピーするコードが次の通りになります。
Sub そのままコピー()
'範囲を宣言
Dim CopyAr As Range
Dim PastePnt As Range
'コピー元と貼り付け先を設定
Set CopyAr = Sheets("東京").Range("A1:K86")
Set PastePnt = Sheets("貼り付け先").[A1]
'コピー
CopyAr.Copy PastePnt
End Sub※この記事では、協会けんぽの東京の健康保険・厚生年金保険の保険料額表をもとにしています。
※事前に「貼り付け先」というシートを作成しています。
◼️実行結果
範囲の変数を宣言 → 範囲を設定 → コピー実行というのが全体の流れになります。
実行結果を見てもらったらわかるように、行列の幅や高さはコピーされません。
行の高さはフォントサイズに合わせて広がっています。
列幅はそのままで、文字がはみ出して表示される結果になりました。
壱通常のコピーして貼り付ける方法では、列幅と行幅はコピペできません。
列幅をコピーする方法
列幅をコピーする方法はいくつかありますので、その方法についてご紹介します。
列範囲を指定して列ごとコピーする
先ほどご紹介した方法では列幅がコピーできませんでした。列範囲を指定して、列ごとコピーしてみましょう。
Sub 列幅コピー_列ごと()
'範囲を宣言
Dim CopyAr As Range
Dim PastePnt As Range
'コピー元と貼り付け先を設定
Set CopyAr = Sheets("東京").Range("A:K")
Set PastePnt = Sheets("貼り付け先").[A1]
'コピー
CopyAr.Copy PastePnt
End Sub
■実行結果
7行目のコピー元の範囲をセル指定（A1:K86）から列指定（A:K）に変更しています。
列ごとコピーしているため、列幅もまとめてコピーすることができました。
PasteSpecailメソッドのxlPasteColumnWidthsを使って列幅をコピーする
Excelには形式を選択して貼り付けることができる機能があります。VBAでは、「PasteSpecialメソッド」と言います。
このPasteSpecialメソッドのxlPasteColumnWidthsを使って、列幅をコピーすることができます。
Sub 列幅コピー_PasteSpecial()
'範囲を宣言
Dim CopyAr As Range
Dim PastePnt As Range
'コピー元と貼り付け先を設定
Set CopyAr = Sheets("東京").Range("A1:K86")
Set PastePnt = Sheets("貼り付け先").[A1]
'コピー
CopyAr.Copy
PastePnt.PasteSpecial xlPasteColumnWidths
End Sub■実行結果
10行目でコピーし、11行目で貼り付け先に列幅を貼り付けるように変更しています。
列ごとコピーしているため、列幅もまとめてコピーすることができました。
壱CopyAr.Copy PastePnt
を9行目と10行目の間に追加すれば、列ごとコピーした結果と同じようになります。
繰り返し処理の「For」文を使って列幅をコピーする
繰り返し処理を行うFor文を使って、列幅をコピーすることもできます。
Sub 列幅コピー_For文()
'範囲を宣言
Dim CopyAr As Range
Dim PastePnt As Range
Dim i As Long
'コピー元と貼り付け先を設定
Set CopyAr = Sheets("東京").Range("A1:K86")
Set PastePnt = Sheets("貼り付け先").[A1]
'コピー
CopyAr.Copy PastePnt
'列幅コピー
For i = 1 To CopyAr.Columns.Count
PastePnt.Columns(i).ColumnWidth = CopyAr.Columns(i).ColumnWidth
Next
End Sub■実行結果
通常のコピーをした後、13～15行目で列幅をコピーするFor文を追加しています。
コピー元の列数だけ、貼り付け先の列幅をコピー元からコピーする処理になります。
行幅（行の高さ）をコピーする方法
行の高さをコピーする方法も、列幅のコピーとほぼ同じになります。ですが、PasteSpecialメソッドには、行の高さのコピーして貼り付ける方法がありません。
行範囲を指定して行ごとコピーする
行範囲を指定してコピーすることで、行ごとコピーすることができます。
Sub 行の高さコピー_行ごと()
'範囲を宣言
Dim CopyAr As Range
Dim PastePnt As Range
'コピー元と貼り付け先を設定
Set CopyAr = Sheets("東京").Range("1:86")
Set PastePnt = Sheets("貼り付け先").[A1]
'コピー
CopyAr.Copy PastePnt
End Sub■実行結果
7行目のコピー元の範囲をセル指定（A1:K86）から行指定（1:86）に変更しています。
行ごとコピーしているので、行の高さも同じようにしっかりコピーできています。
繰り返し処理の「For」文を使って行の高さをコピーする
繰り返し処理を行うFor文を使って、行の高さをコピーすることもできます。
Sub 行の高さコピー_For文()
'範囲を宣言
Dim CopyAr As Range
Dim PastePnt As Range
Dim i As Long
'コピー元と貼り付け先を設定
Set CopyAr = Sheets("東京").Range("A1:K86")
Set PastePnt = Sheets("貼り付け先").[A1]
'コピー
CopyAr.Copy PastePnt
'行の高さコピー
For i = 1 To CopyAr.Rows.Count
PastePnt.Rows(i).RowHeight = CopyAr.Rows(i).RowHeight
Next
End Sub■実行結果
通常のコピーをした後、13～15行目で行の高さをコピーするFor文を追加しています。
コピー元の行数だけ、貼り付け先の行の高さをコピー元からコピーする処理になります。
列幅と行幅（列の高さ）もまとめてコピーする
最後に、列幅と行の高さをコピーする方法を組み合わせて、列幅と行の高さを保持したままコピーする方法についてご紹介します。
Sub 行列もまとめてコピー()
'範囲を宣言
Dim CopyAr As Range
Dim PastePnt As Range
Dim i As Long
'コピー元と貼り付け先を設定
Set CopyAr = Sheets("東京").Range("A1:K86")
Set PastePnt = Sheets("貼り付け先").[A1]
'コピー
CopyAr.Copy PastePnt
'列幅コピー
For i = 1 To CopyAr.Columns.Count
PastePnt.Columns(i).ColumnWidth = CopyAr.Columns(i).ColumnWidth
Next
'行の高さコピー
For i = 1 To CopyAr.Rows.Count
PastePnt.Rows(i).RowHeight = CopyAr.Rows(i).RowHeight
Next
End Sub■実行結果
通常のコピーをした後、12～19行目で列幅と行の高さをコピーするFor文を追加しています。
この処理を追加することで列幅と行の高さを保持したままコピーすることができました。
まとめ
この記事では、VBAを使って特定のセル範囲を行列を保持したままコピーして貼り付ける方法についてご紹介しました。
列幅や行の高さがコピーされず困っていた方が多いかと思いましたので、ご参考にして頂けたら幸いです。
コメント