エクセルで列・行の長さをそのままでコピーしたい

質問

こんにちは。

エクセルで文章（表）を作って、同じ枠組でもう１個表を作りたい・・・っていう時、その表をコピーして貼り付けると思うんですけど、横なり下なりに貼り付けると列や行の幅が元の設定に戻ってしまうので困っています。
職場ではエクセル2000、自宅は98ですが、両方とも同じ症状が出ます。

「形式を選択して貼り付け」というところで「列幅」を選択しても何も変化が起こりません。

使い方が悪いのだとは思うのですが、どうすればよいのでしょうか？
教えてくださいm(_ _)m

回答No.1

mu2011 · ベストアンサー

下方向なら行単位、横方向なら列単位でコピーし、それぞれのコピー先の行、列でコピーしたセルの挿入を実行しては如何でしょうか。

お礼

行／列でコピーすればよかったんですね。

ちゃんとできました。
ありがとうございましたm(_ _)m

回答No.2

Wendy02

こんにちは。

VBAで考えてみました。標準モジュールに以下のようなコードを貼り付けて、保存し、再び、ブックを開ければ、設定されます。

ショートカットは、現在は、 Alt + C （コピー）, Alt + S （貼り付け）になっています。

'---------------------------------------
Option Explicit
Dim myRows()
Dim myCols()
Dim Rng As Range
Sub CopyRowColumn()
'セル幅・高さコピー
　 Dim r As Range
　 Dim i As Long, j As Long
　 Set Rng = Selection
　 For Each r In Rng.Columns(1).Cells
　　　ReDim Preserve myRows(i)
　　　myRows(i) = r.RowHeight
　　　i = i + 1
　 Next r
　 For Each r In Rng.Rows(1).Cells
　　　ReDim Preserve myCols(j)
　　　myCols(j) = r.ColumnWidth
　　　j = j + 1
　 Next r
　 MsgBox "ペーストする場所を選んでください"
End Sub
Sub PasteRowColumn()
'セル高さ・幅貼り付け
　 Dim i As Long, j As Long
　 Dim dum1 As Variant, dum2 As Variant
　 Dim c As Range
　 On Error GoTo ErrMsg
　 dum1 = myRows(0)
　 dum2 = myCols(0)
　 Application.ScreenUpdating = False
　 With ActiveCell
　　　For i = LBound(myCols) To UBound(myCols)
　　　　 .Offset(, i).ColumnWidth = myCols(i)
　　　Next i
　　　For j = LBound(myRows) To UBound(myRows)
　　　　 .Offset(j).RowHeight = myRows(j)
　　　Next j
　 End With
　 '値貼り付け
　 For Each c In Rng.Cells
　　 ActiveCell.Range(c.Address).Value = c.Value
　 Next c
　 Application.ScreenUpdating = True
　 Exit Sub
ErrMsg:
　 MsgBox Err.Number & " 元のデータがなくなったようです。"
End Sub
Sub Auto_Open()
'ショートカット設定
'コピー
Application.OnKey "%c", "CopyRowColumn"
Application.OnKey "%C", "CopyRowColumn"　 'Alt + C
'貼り付け
Application.OnKey "%s", "PasteRowColumn"
Application.OnKey "%S", "PasteRowColumn"　'Alt + S
End Sub
Sub Auto_Close()
'ショートカット設定解除
Application.OnKey "%c"
Application.OnKey "%C"
Application.OnKey "%s"
Application.OnKey "%S"
End Sub

お礼

ありがとうございましたm(_ _)m