将行高从Sheet1复制到Sheet2时VBA代码失效问题求助

看起来你这段代码不仅有语法断片的问题，还没处理好两张表行号不匹配的核心需求，我来帮你梳理修复一下：

核心思路 #

因为两张表的表格在不同行号，我们需要：

1. 精准定位Sheet1中需要复制行高的行范围
2. 定位Sheet2中要应用行高的对应行范围（行数要和Sheet1的目标行数一致）
3. 逐行复制行高，避免格式错位

完整可运行代码 #

Sub CopyRowHeightsToSheet2()
    ' 先取消所有隐藏行，确保能获取完整行高
    Call Unhide
    
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' --- 定位Sheet1的目标行范围 ---
    Dim ws1StartRow As Long, ws1LastRow As Long
    ' 用"CYCLE 1"作为Sheet1表格的起始标识（可根据实际调整）
    On Error Resume Next
    ws1StartRow = Application.WorksheetFunction.Match("CYCLE 1", ws1.Range("A:A"), 0) + 1 ' 假设标题行是CYCLE 1，数据行从下一行开始
    On Error GoTo 0
    
    If ws1StartRow = 0 Then
        MsgBox "在Sheet1中未找到CYCLE 1标识，请检查！"
        Exit Sub
    End If
    
    ' 获取Sheet1数据区域的最后一行（以B列非空为判断）
    ws1LastRow = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    Dim totalRows As Long
    totalRows = ws1LastRow - ws1StartRow + 1 ' 需要复制的总行数
    
    ' --- 定位Sheet2的目标行范围 ---
    Dim ws2StartRow As Long
    ' 这里根据Sheet2的实际表格位置设置起始行，示例值为第5行
    ' 也可以用和Sheet1一样的标识匹配逻辑，比如：
    ' On Error Resume Next
    ' ws2StartRow = Application.WorksheetFunction.Match("CYCLE 1", ws2.Range("A:A"), 0) + 1
    ' On Error GoTo 0
    ws2StartRow = 5 ' 请替换为Sheet2表格的实际起始行号
    
    ' --- 逐行复制行高 ---
    Dim i As Long
    For i = 0 To totalRows - 1
        ws2.Rows(ws2StartRow + i).RowHeight = ws1.Rows(ws1StartRow + i).RowHeight
    Next i
    
    MsgBox "行高复制完成！"
End Sub

' 你的Unhide子程序（确保行都可见）
Sub Unhide()
    ThisWorkbook.Sheets("Sheet1").Rows.Hidden = False
    ThisWorkbook.Sheets("Sheet2").Rows.Hidden = False
End Sub

关键说明 #

• 标识匹配调整：如果你的表格起始标识不是"CYCLE 1"，或者判断逻辑不同（比如用特定列的表头），可以修改Match函数的查找范围和关键字
• Sheet2起始行：一定要根据Sheet2的实际表格位置修改ws2StartRow的值，确保行数和Sheet1的目标行数完全对应
• 错误处理：加入了错误捕获逻辑，避免因找不到标识导致代码崩溃
• 逐行复制优势：相比批量设置，逐行复制能精准对应不同行号的表格，避免格式错位

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