Excel VBA开发需求：按列I文本批量剪切粘贴行至对应标题下

问题根源分析 #

之前的代码只能处理第一行，大概率是因为使用了从前往后的循环逻辑：当剪切第i行后，原本的i+1行会自动上移成为新的第i行，但循环索引i会继续递增，直接跳过了这行数据。修改后出现故障，可能是循环方向未调整，或是目标粘贴行号未动态更新，导致覆盖已有内容。

正确实现代码 #

Sub MoveRowsByKeyword()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetCBLRow As Long
    Dim targetFIBERRow As Long
    
    ' 指定操作工作表，根据实际表名修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 动态定位目标标题行（若标题位置固定，可直接赋值如targetCBLRow = 23）
    targetCBLRow = ws.Cells.Find(What:="CABLE RACK AND IRONWORK MATERIAL", LookIn:=xlValues, LookAt:=xlWhole).Row + 1
    targetFIBERRow = ws.Cells.Find(What:="FIBER MANAGMENT MATERIAL", LookIn:=xlValues, LookAt:=xlWhole).Row + 1
    
    ' 获取I列数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    ' 处理含"CBL"的行：从后往前循环，避免剪切后行号错乱
    For i = lastRow To 1 Step -1
        If InStr(1, ws.Cells(i, "I").Value, "CBL", vbTextCompare) > 0 Then
            ws.Rows(i).Cut ws.Rows(targetCBLRow)
            targetCBLRow = targetCBLRow + 1 ' 粘贴后目标行下移，准备下一次粘贴
        End If
    Next i
    
    ' 重新获取最后一行（因剪切操作改变了数据区域）
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    ' 处理含"FIBER"的行，同样从后往前循环
    For i = lastRow To 1 Step -1
        If InStr(1, ws.Cells(i, "I").Value, "FIBER", vbTextCompare) > 0 Then
            ws.Rows(i).Cut ws.Rows(targetFIBERRow)
            targetFIBERRow = targetFIBERRow + 1
        End If
    Next i
    
    ' 清除剪切板，避免Excel弹出粘贴提示
    Application.CutCopyMode = False
End Sub

关键细节说明 #

• 从后往前循环：For i = lastRow To 1 Step -1，确保剪切行后，前面未处理的行不会因索引递增被跳过。
• 动态目标行：用Find方法定位标题行，适配标题位置变动的场景；若标题位置固定，可直接写targetCBLRow = 23（标题在第22行，下方第一行是23行）。
• 忽略大小写匹配：vbTextCompare参数让匹配不区分大小写（如"cbl"也会被识别），若需严格区分，可删除该参数。
• 更新目标行号：每次粘贴后将目标行号+1，确保后续行追加在已有内容下方，不会覆盖。

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