Найти текст, вставить строки, а затем скопировать и вставить после изменения определенного текста

Question

У меня есть данные строк и столбцов, и я бы хотел, чтобы мой макрос нашел определенный текст (местоположение) в одном столбце и после нахождения местоположения создайте 2 или более строк и скопируйте данные найденной строки местоположения, но измените местоположение на шаг 1. Например, если он найдет значение в столбце «Столбец Лондона», затем скопируйте всю строку в две новые вставленные строки, но измените текст Лондона с помощью 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