| 
    
     |  | 手動で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
 
 |  |