daily pastebin goal
49%
SHARE
TWEET

Untitled

a guest Feb 14th, 2018 62 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. enter code here
  2.  
  3. OrigRowHeight = SafeRange.RowHeight
  4. OrigColWidth = SafeRange.ColumnWidth
  5.  
  6. CurRow = ActiveCell.Row
  7. CurCol = ActiveCell.Column
  8. NumMergeCols = ActiveCell.MergeArea.Count
  9. LastCol = CurCol + NumMergeCols - 1
  10.  
  11. For i = CurCol To LastCol
  12.     CombinedColWidth = CombinedColWidth + Cells(CurRow, i).ColumnWidth
  13. Next i
  14.  
  15. ' Most of the following code came from Superuser user6261023 (My Thanks)
  16. With SafeSheet.Range(SafeRange.Address)
  17.     TargetRange.Copy
  18.     .PasteSpecial xlPasteAll
  19.     .UnMerge
  20.     .ColumnWidth = CombinedColWidth
  21.     .Value = TargetRange.Value
  22.     .EntireRow.AutoFit
  23.     NeededRowHeight = 1.05 * .RowHeight / TargetRange.MergeArea.Rows.Count
  24.     .ClearContents
  25.     .ClearFormats
  26.     .RowHeight = OrigRowHeight
  27.     .ColumnWidth = OrigColWidth
  28. End With
  29.  
  30. 'Return NeededRowHeight
  31. NewRowHeight = NeededRowHeight
  32.    
  33. OrigRowHeight = SafeRange.RowHeight
  34. OrigColWidth = SafeRange.ColumnWidth
  35.  
  36. CurRow = ActiveCell.Row
  37. CurCol = ActiveCell.Column
  38. NumMergeCols = ActiveCell.MergeArea.Count
  39. LastCol = CurCol + NumMergeCols - 1
  40.  
  41. For i = CurCol To LastCol
  42.     CombinedColWidth = CombinedColWidth + Cells(CurRow, i).ColumnWidth
  43. Next i
  44.  
  45. ' Most of the following code came from Superuser user6261023 (My Thanks)
  46. With SafeSheet.Range(SafeRange.Address)
  47.     TargetRange.Copy
  48.     .PasteSpecial xlPasteAll
  49.     .UnMerge
  50.     .ColumnWidth = CombinedColWidth
  51.     .Value = TargetRange.Value
  52.     .EntireRow.AutoFit
  53.     NeededRowHeight = 1.05 * .RowHeight / TargetRange.MergeArea.Rows.Count
  54.     .ClearContents
  55.     .ClearFormats
  56.     .RowHeight = OrigRowHeight
  57.     .ColumnWidth = OrigColWidth
  58. End With
  59.  
  60. 'Return NeededRowHeight
  61. NewRowHeight = NeededRowHeight
RAW Paste Data
Top