シートをコピーする際、行の高さもコピーしたい。

Question

実現したいこと
複数シートを一つのシートに縦にまとめたいのですが
色々調べたところ、行の高さコピーだけできないみたいで
試行錯誤しましたが、問題は解決できませんでした。

下記コードが今組んでるコードなのですが
これに付け加えて、行の高さもコピーしたいです。
ご教授お願いいたします。

Sub Test()
Dim i As Long, ad As Integer, r As Long
Dim gyosu As Long
Dim c As Long
Sheets(1).Cells.Clear
gyosu = Selection.Rows.Count
For i = 2 To ActiveWorkbook.Sheets.Count
Sheets(i).UsedRange.Columns("A:M").Copy
r = Sheets(1).UsedRange.Rows.Count
If i = 1 Then ad = 0 Else ad = 2 '※
Cells(r, 1).Offset(ad).Select '※
ActiveSheet.Paste
Sheets("まとめ").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
Next
Next
Sheets(1).Columns.AutoFit
End Sub

Answer 1

こんなサイトありましたよ。
https://www.relief.jp/docs/excel-macro-copy-row-heights-column-widths.html
前の質問は、解決されたようでよかったです。自己解決で質問を閉じることをお勧めします。

Comments

[mokoxx]

アドバイスありがとうございます。URLも参考にさせていただきます。

Answer 2

行の高さはRangeオブジェクト内にあるRowHeightプロパティで指定や取得が出来るようです。

Sub main()
    Dim x As Integer
    x = 80
    ActiveSheet.Range(Cells(1, 1), Cells(1, 1)).RowHeight = x
    ActiveSheet.Range(Cells(2, 2), Cells(2, 2)).RowHeight = ActiveSheet.Range(Cells(1, 1), Cells(1, 1)).RowHeight
End Sub

コピペする際にこのプロパティの値のみ抜き出して変数にいれておけば想定通りの動作になると思います。

Comments

[mokoxx]

ありがとうございます。試してみます！