Excel VBA技术求助：复制粘贴后行高异常，需匹配指定单元格行高

我来帮你梳理下这个问题——复制行到新工作表后行高异常、手动设置行高代码失效，还要同步原单元格行高，结合你提到的取消合并、排序、重新合并的操作，咱们一步步解决：

一、先排查Rows("3:25").RowHeight = 25失效的核心原因 #

你遇到的代码不生效，大概率是以下两个常见坑：

• 未明确指定目标工作表：如果代码执行时，当前激活的不是你要设置的新工作表，这条代码会作用在当前活动表上，自然看不到效果。
• 合并单元格干扰：如果目标行的单元格处于合并状态，直接设置行高可能只会影响合并区域的第一行，或者完全不生效。

二、针对性解决方案 #

1. 确保代码作用于正确的工作表 #

修改代码，明确指定目标工作表对象，比如：

' 替换成你的新工作表名称
ThisWorkbook.Sheets("新工作表").Rows("3:25").RowHeight = 25

2. 同步原工作表的行高（替代固定值设置） #

如果需要根据原单元格行高来匹配目标行，直接遍历源表和目标表的对应行赋值即可，比固定值更灵活：

Dim wsSource As Worksheet, wsTarget As Worksheet
Dim i As Integer

' 定义源表和目标表
Set wsSource = ThisWorkbook.Sheets("你的源工作表")
Set wsTarget = ThisWorkbook.Sheets("新工作表")

' 同步3到25行的行高
For i = 3 To 25
    wsTarget.Rows(i).RowHeight = wsSource.Rows(i).RowHeight
Next i

3. 结合取消合并、排序、重新合并的完整流程 #

你的操作涉及多个步骤，代码执行顺序非常关键，推荐的流程是：
复制行到新表 → 取消合并单元格 → 设置/同步行高 → 按日期排序 → 重新合并单元格

给你整理了完整的示例代码，你可以根据实际需求调整细节：

Sub CopySortSyncRowHeight()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long
    Dim sortRange As Range
    
    ' 替换为你的实际工作表名称
    Set wsSource = ThisWorkbook.Sheets("数据源")
    Set wsTarget = ThisWorkbook.Sheets("新工作表")
    
    ' 清空目标表（可选，避免旧内容干扰）
    wsTarget.Cells.Clear
    
    ' 复制源表3-25行到目标表（连带格式和行高，若只需复制值可改用PasteSpecial）
    wsSource.Rows("3:25").Copy Destination:=wsTarget.Rows("3")
    
    ' 第一步：取消所有合并单元格
    wsTarget.Cells.UnMerge
    
    ' 第二步：设置行高（二选一）
    ' 选项1：统一设置为25
    wsTarget.Rows("3:25").RowHeight = 25
    ' 选项2：同步源表行高
    ' For i = 3 To 25
    '     wsTarget.Rows(i).RowHeight = wsSource.Rows(i).RowHeight
    ' Next i
    
    ' 第三步：按指定列（假设是第2列，即B列）日期排序
    lastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    Set sortRange = wsTarget.Range("A3:" & wsTarget.Cells(lastRow, wsTarget.Columns.Count).Address)
    
    With wsTarget.Sort
        .SortFields.Clear
        .SortFields.Add Key:=wsTarget.Range("B3:B" & lastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange sortRange
        .Header = xlNo ' 如果你的表头在第2行，改为xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    
    ' 第四步：重新合并单元格（示例为合并A列相同内容的单元格，你可按需修改）
    Dim colToMerge As Range, cell As Range, mergeRange As Range
    Set colToMerge = wsTarget.Range("A3:A" & lastRow)
    
    Set mergeRange = colToMerge.Cells(1)
    For Each cell In colToMerge
        If cell.Value = mergeRange.Value Then
            Set mergeRange = Union(mergeRange, cell)
        Else
            mergeRange.Merge
            Set mergeRange = cell
        End If
    Next cell
    mergeRange.Merge ' 合并最后一组
End Sub

三、额外注意事项 #

• 如果复制时只需要粘贴值（不需要源表格式），可以用PasteSpecial xlPasteValues，但这种情况下行高不会被复制，必须手动设置或同步。
• 排序时要确保排序范围包含所有需要排序的列，避免数据错位。
• 重新合并单元格时，建议先确认排序后的单元格内容符合你的合并规则，避免合并错误。

内容的提问来源于stack exchange，提问作者user9663005