查找文本，插入行，然后在更改特定文本后复制并粘贴

问题描述：

我有一个行和列的数据，我希望我的宏在一列中找到某些文本（位置），并在找到该位置时创建2行或更多行并复制找到的位置行的数据，但将位置以1的增量更改。例如，如果它在位置列伦敦中找到值，则将整行复制到2个新插入的行，但将伦敦文本更改为伦敦1和伦敦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

要得到一个有意义的答案，请阅读常见问题的说明http://stackoverflow.com/questions/how-to-ask和我个人最喜欢的：http://mattgemmell.com/2008/12/08 /你曾尝试过什么 – 2013-04-30 11:14:29

一个很好的入门建议，可以让宏做这样的事情。打开记录功能并手动执行这些步骤。然后查看它创建的代码。这不会是完美的，但会让你开始。 – 2013-04-30 12:33:22

答

我敢肯定，这是你追求的。如果不清楚，我可以解释。

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

查找文本，插入行，然后在更改特定文本后复制并粘贴

相关推荐