|
手動でCopyしても列幅と行高さはCopyされないと思いますが?
如何しても、Copyでしたいなら、こんな風に成るのかな?
Public Sub Sample2()
Dim objSheet As Worksheet
Dim i As Long
Dim strTop As String
Dim wksPaste As Worksheet
'画面更新を停止
Application.ScreenUpdating = False
'ActiveSheetの参照を保存
Set objSheet = ActiveSheet
'追加したBookの参照を保存
Set wksPaste = Workbooks.Add.Worksheets(1)
With objSheet.UsedRange
'使用範囲の先頭位置を保存
strTop = .Cells(1).Address
'元となるExcelのデータをコピー
.Copy Destination:=wksPaste.Range(strTop)
'データの有る列の列幅を設定
For i = 1 To .Columns.Count
wksPaste.Range(strTop).Offset(, i - 1).ColumnWidth _
= .Cells(1, i).ColumnWidth
Next i
'データの有る行の行高さを設定
For i = 1 To .Rows.Count
wksPaste.Range(strTop).Offset(i - 1).RowHeight _
= .Cells(i, 1).RowHeight
Next i
End With
'画面更新を再開
Application.ScreenUpdating = False
Set wksPaste = Nothing
Set objSheet = Nothing
End Sub
|
|