Question

我有行和列的数据，我希望我的宏在一列中找到某些文本（位置），找到位置后创建2行或更多行并复制找到的位置行的数据但更改位置增量为1.例如，如果它在位置列伦敦找到一个值，则将整行复制到2个新插入的行，但用London1和London 2更改伦敦文本，依此类推。请帮忙。

码

sub Insert_CopyPaste()

    Dim LastRow As Long 
    With Sheets("Sheet2") 
        .Activate 
        LastRow = .Range("C6000").End(xlUp).Row 
        For i = 2 To LastRow 
            If (InStr(1, .Range("c" & i).Value, "03M-EX", vbTextCompare) > 0) Then 
                .Range("a" & i).EntireRow.Copy 
                .Range("a" & i + 1).EntireRow.Insert 
                .Range("a" & i + 1).PasteSpecial xlPasteValues 
            End If 
        Next
    End With 
    Exit Sub 

End Sub

Answer 1

我确信这就是你所追求的。如果不清楚我可以解释。

sub Insert_CopyPaste()

    Dim LastRow As Long, i as long, txt as string
    txt = "03M-EX" 'set text to search
    With Sheets("Sheet2") 

        LastRow = .Range("C6000").End(xlUp).Row  
        while i <= lastrow 

            If .Range("c" & i).Value = txt Then 

                .Range("a" & i).EntireRow.Copy 
                .Range("a" & i + 1).EntireRow.Insert 
                .Range("a" & i + 1).PasteSpecial xlPasteValues 
                .Range("c" & i + 1).value = txt & "1" 'add 1 to text

                i = i + 1 'skip newly added row
                lastrow = lastrow + 2 'increase last row reference by 2

                .Range("a" & i).EntireRow.Copy 
                .Range("a" & i + 1).EntireRow.Insert 
                .Range("a" & i + 1).PasteSpecial xlPasteValuesxlPasteValues 
                .Range("c" & i + 1).value = txt & "2"

            End If 

            i = i + 1 'goto next row to check 

        loop
    End With  
End Sub

找到文本，插入行然后复制＆amp;更改特定文本后粘贴

1 个答案: