VBA技术需求：实现H列非空时插入新行并将内容复制至新行F列

Got it, let's tweak your code to hit your exact requirement—inserting rows below non-empty H column cells and copying that H column content to the new row's F column. Here's the breakdown of fixes and updated code:

Issues in Your Original Code #

• Forward loop skips rows: When you insert a row while looping top-to-bottom, the next row you need to check gets pushed down and the loop skips it. We’ll fix this by looping from the last row upwards instead.
• Missing content copy: Your code inserts rows but doesn’t transfer the H column value to the new row’s F column—this is the core functionality we’ll add.

Updated VBA Code #

Sub SetupData()
    ' 将特定单元格内容从PasteDataHere工作表复制到目标位置
    Application.ScreenUpdating = False
    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long
    Dim lastRowS2 As Long
    Dim i As Long ' 用于反向循环的变量
    
    Set s1 = Sheets("PasteDataHere")
    Set s2 = Sheets("Step1")
    
    ' --- 保留你的原有数据复制逻辑，优化了目标单元格定位避免覆盖 ---
    ' H列 → A列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "H").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)
    s1.Range("H1", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2
    
    ' I列 → B列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "I").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "B").End(xlUp).Offset(1, 0)
    s1.Range("I1", s1.Cells(iLastRowS1, "I")).Copy iLastCellS2
    
    ' K列 → C列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "K").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "C").End(xlUp).Offset(1, 0)
    s1.Range("K1", s1.Cells(iLastRowS1, "K")).Copy iLastCellS2
    
    ' M列 → D列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "M").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "D").End(xlUp).Offset(1, 0)
    s1.Range("M1", s1.Cells(iLastRowS1, "M")).Copy iLastCellS2
    
    ' N列 → E列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "N").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "E").End(xlUp).Offset(1, 0)
    s1.Range("N1", s1.Cells(iLastRowS1, "N")).Copy iLastCellS2
    
    ' E列 → F列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "E").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "F").End(xlUp).Offset(1, 0)
    s1.Range("E1", s1.Cells(iLastRowS1, "E")).Copy iLastCellS2
    
    ' G列 → G列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "G").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "G").End(xlUp).Offset(1, 0)
    s1.Range("G1", s1.Cells(iLastRowS1, "G")).Copy iLastCellS2
    
    ' S列 → H列
    iLastRowS1 = s1.Cells(s1.Rows.Count, "S").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "H").End(xlUp).Offset(1, 0)
    s1.Range("S1", s1.Cells(iLastRowS1, "S")).Copy iLastCellS2
    
    ' --- 核心功能：插入行并复制H列内容到新行F列 ---
    ' 获取Step1工作表H列最后一行
    lastRowS2 = s2.Cells(s2.Rows.Count, "H").End(xlUp).Row
    
    ' 从下往上循环，避免插入行导致漏处理
    For i = lastRowS2 To 1 Step -1
        With s2.Cells(i, "H")
            If Not IsEmpty(.Value) Then
                ' 在当前行下方插入新行
                .Offset(1, 0).EntireRow.Insert
                ' 将当前H列内容复制到新行的F列（H到F向左偏移2列）
                .Offset(1, -2).Value = .Value
            End If
        End With
    Next i
    
    Application.ScreenUpdating = True
End Sub

Key Fixes Explained #

1. Reverse Loop: By looping from the last row of column H up to row 1 (For i = lastRowS2 To 1 Step -1), inserting rows won’t shift the rows we haven’t checked yet—no more skipped rows.
2. Content Copy to F Column: After inserting the new row, .Offset(1, -2).Value = .Value moves the H column value to the new row’s F column. The -2 means shifting left 2 columns (H is column 8, F is column 6).
3. Safer Data Copy: I changed Offset(0,0) to Offset(1,0) when finding the target cell in Step1, so you won’t overwrite existing data if those columns already have content.

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