Hi there,
My thought is to paste formats to a new, temporary worksheet, count the rows
and save their heights as per your code, then delete the temporary worksheet
and restore the ActiveSheet and Selection and then apply the row heights per
your code. I didn't test it much but it works pasting from one sheet to
another:
Dim wsActiveSheet As Worksheet
Dim rngActiveCell As Range
Dim wsTempSheet As Worksheet
Dim copyRng As Range
Dim rowRng As Range
Dim numRows As Long
Dim rowHgt() As Double
Dim rowCell As Range
Dim i As Long
Dim j As Long
Dim a
Application.ScreenUpdating = False
Set wsActiveSheet = ActiveSheet
Set rngActiveCell = Selection
'need to have "copied" a range in order to "paste" the row heights
'at a new location
If Application.CutCopyMode = False Then Exit Sub
'create a range object that storse the range that was copied
'(i.e. the one with the cut/copy border)
ThisWorkbook.Worksheets.Add
Set wsTempSheet = ActiveSheet
wsTempSheet.Range("A1").PasteSpecial (xlPasteFormats)
Set copyRng = Selection 'want "Selection" to be the "copied" range
'maybe use a sheet selection change/deactivate
event,
'but that doesn't cure a same sheet pasting
Debug.Print copyRng.Address
numRows = copyRng.Rows.Count 'copy the number of rows in the copied Range
'create a new range object that contains only 1 column
Set rowRng = copyRng.Range(Cells(1, 1), Cells(numRows, 1))
ReDim rowHgt(1 To numRows)
'store the row heights of the copied range
i = 0
For Each rowCell In rowRng.Cells
i = i + 1
rowHgt(i) = rowCell.RowHeight
Debug.Print i; ":"; rowHgt(i)
Next
Application.DisplayAlerts = False
wsTempSheet.Delete
Application.DisplayAlerts = True
'"paste" the row heights where the active cell is
wsActiveSheet.Activate
rngActiveCell.Select
For j = LBound(rowHgt) To UBound(rowHgt)
Selection.Cells(1, 1).Offset(j - 1, 1).RowHeight = rowHgt(j)
Next
'need to build an error handler to handle a situation where you
'have 10 rows copied and your paste cell is on row 65,530 and
'there are only 7 row location that can be "pasted"
Application.ScreenUpdating = True
End Sub
hth,
Doug
<(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> My code thus far is below.
>
> Does anyone know how Microsoft programmatically performs paste special
> in Excel? The copy, paste special - column widths is useful, but I
> want to perform a paste special - row heights. Below I have included
> some syntax for this, but there is one problem - accessing the CutCopy
> range.
>
> I have done some searching and have found individuals who have said
> that is not possible (posts from 2004); however, there must be some
> way to do this, otherwise paste special would not exist at all. This
> being said, my hang up is on the syntax line below that states "Set
> copyRng = Selection ..." I want the "Selection" to be the CutCopy
> range.
>
> So, one idea that I have is to see if there is a way to determine
> which sheet has the CutCopyMode activated. (I know that
> Application.CutCopyMode will identify from an application point of
> view, but I'm wondering if this can be determined from a worksheet
> level).
>
> Additionally, I found the code below posted by Bob Phillips; however,
> I want to place this row heights macro in my personal.xls file so that
> I can use it on any workbook.
>
> Public oldCell As Range
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> If Not oldCell Is Nothing Then MsgBox oldCell.Address
> Set oldCell = Target
> End Sub
>
> Any ideas would be greatly appreciated. Thanks in advance.
>
> Sub paste_Row_Heights()
>
> 'This sub procedure is intended to act as a copy, paste special
> 'wherein the row heights are "pasted". Excel has a copy, paste
> 'special - column widths, but no paste special - row heights.
>
> Dim copyRng As Range
> Dim rowRng As Range
> Dim numRows As Long
> Dim rowHgt() As Double
> Dim rowCell As Range
> Dim i As Long
> Dim j As Long
> Dim a
>
> 'need to have "copied" a range in order to "paste" the row heights
> 'at a new location
> If Application.CutCopyMode = False Then Exit Sub
>
> 'create a range object that storse the range that was copied
> '(i.e. the one with the cut/copy border)
>
> Set copyRng = Selection 'want "Selection" to be the "copied" range
> 'maybe use a sheet selection change/deactivate
> event,
> 'but that doesn't cure a same sheet pasting
> Debug.Print copyRng.Address
>
> numRows = copyRng.Rows.Count 'copy the number of rows in the copied
> range
>
> 'create a new range object that contains only 1 column
>
> Set rowRng = copyRng.Range(Cells(1, 1), Cells(numRows, 1))
>
> ReDim rowHgt(1 To numRows)
>
> 'store the row heights of the copied range
>
> i = 0
> For Each rowCell In rowRng.Cells
> i = i + 1
> rowHgt(i) = rowCell.RowHeight
> Debug.Print i; ":"; rowHgt(i)
> Next
>
> '"paste" the row heights where the active cell is
>
> For j = LBound(rowHgt) To UBound(rowHgt)
> Selection.Cells(1, 1).Offset(j - 1, 1).RowHeight = rowHgt(j)
> Next
>
> 'need to build an error handler to handle a situation where you
> 'have 10 rows copied and your paste cell is on row 65,530 and
> 'there are only 7 row location that can be "pasted"
> End Sub
>
|
Similar Threads
