David, here's another suggestion. Replace your entire code with this.
Code:Private Sub Worksheet_Change(ByVal Target As Range) Dim cM As Range Dim AutoFitRng As Range Dim MergeWidth As Single Dim NewRowHt As Single Dim str01 As String str01 = "OrderNote" If Not Intersect(Target, Range(str01)) Is Nothing Then Application.ScreenUpdating = False Set AutoFitRng = Range(str01).MergeArea For Each cM In AutoFitRng.Cells MergeWidth = cM.ColumnWidth + MergeWidth Next cM With Worksheets.Add .Columns(1).ColumnWidth = MergeWidth With .Cells(1) .Value = AutoFitRng.Cells(1).Value .WrapText = True .EntireRow.AutoFit End With NewRowHt = .Rows(1).Height Application.DisplayAlerts = False .Delete Application.DisplayAlerts = False End With With AutoFitRng .WrapText = True .RowHeight = NewRowHt End With Application.ScreenUpdating = True End If End Sub




Reply With Quote
Bookmarks