Thread: Paste Special
View Single Post
  #6   Report Post  
rberke rberke is offline
Junior Member
 
Posts: 1
Default

Don't know if you are interested in vba solution, but if you are, read on.

I had similar problem today. I wrote the following vba macro. It has not been well tested, but it worked for me and I hope it helps you.

You can put into personal.xls.

I also have a macro in personal.xls which I have assign to ctlr shift n.

Sub askmacro()
s = Trim(LCase(InputBox("enter macro code")))
If Right(s, 1) = "s" Then s = Left(s, Len(s) - 1)
If s = "" Then Exit Sub

Select Case s
Case "pastediff": Call PasteSpecialHighlightDifference
Case "rtrim": Call myRtrimall
Case "paste45", "ps45": Call PasteHdgs45
Case "psrowheight": Call PasteSpecialRowHeights

Case Else
MsgBox s & "=no such shortcut"
End
End Select

End Sub


-------------------------------
Sub PasteSpecialRowHeights()
' Excel's EditPasteSpecial allows you to paste column widths, but not row heights.
' this macro exends that function
'
' to use macro:
' 1 format some rows to have your "ideal row heights"
' 2 select those full rows and copy them to the clipboard
' 3 navigate to the top left cell where you want to paste the row heights
' 4 call macro.
' the destination cells will now have the ideal heights
' future enhancement 1: I don't like requiring user to select full
' rows before they copy.
' this would make it possible for PasteSpecialRowHeights and
' pastespecialcolumnWidths to both use the same clipboard
' future enhancement 2: if target rectangle is more than one cell,
' restrict paste so only the selected rectangle is pasted
' future enhancement 3: bundle together 3 function:
' paste data
' paste row heights
' paste column widths
'
' to test current version quickly add the following steps
' select the ideal rows then Insert Name Define "testsrc"
' select the top left cell in your target area and Insert Name Define "testtgt"
' change constant to say "const testmode = true"

Const testmode = False
If testmode Then
Application.Goto ("testsrc")

Selection.Copy

Application.Goto ("testtgt")
End If

Set tgtsheet = ActiveSheet
Set tgtsel = Selection
Set tgtact = ActiveCell

ActiveWorkbook.Worksheets.Add
newsheetname = ActiveSheet.name

Set TempSheet = ActiveSheet
Selection.Insert Shift:=xlToDown


Dim c As Long

For c = 1 To TempSheet.UsedRange.Rows.Count
tgtsel.Rows(c).RowHeight = TempSheet.Rows(c).RowHeight
Next c

chgix = 0

If chgix = 0 Then
Application.DisplayAlerts = False
TempSheet.Delete
Application.DisplayAlerts = True
tgtsheet.Activate
tgtsel.Select
tgtact.Activate
Else
MsgBox chgix & " future use"
End If


End Sub