Automating copy and paste based on cell value PLS HELP

[Waffels]

1	301	88	4155		MRPXX123	000	000		TW123-50	277541			23.00
2	301	88	4155		MRPXX220	000	000		TW2200-81	277469			18.40
3	301	88	4155		MRPXX220	000	000		TW2200-81	277519			18.40
4	301	88	4155		MRPXX221	000	000		TW221-395	277542			59.80
5	301	88	4155		MRPXX409	000	000		TW409-74	277493			36.80
6	301	88	4155		MRPXX409	000	000		TW409-74	277500			140.76
7	301	88	4155		MRPXX409	000	000		TW409-74	277511			36.80

<colgroup><col span="5"><col><col span="3"><col><col span="2"><col><col></colgroup><tbody>
</tbody>

Hello everyone,

I want to automate a copy and paste. For example id to be able to repaste the bolded values in the cells directly 1 below. I was thinking of using something like this, but I am unsure what would come afterwards as I am a novice.

Sub try()
Dim c As Range
For Each c In Range("J1:K80")
If c.Value Like "*TW747*" Or c.Value Like "*TW691*" Or c.Value Like "*TW2200*" Or c.Value Like "*TW750*" Or c.Value Like "*TW409*" Or c.Value Like "*TW742*" Then

 

[NiMip]

I'm very new to all this too, but I've had a crack! I've made the assumption that blank rows you have in your table aren't already there in the dataset, but should be added by the macro, and only where there is a match with your conditions. I've added comments through the code to explain each line.

Sub try()

Dim c(1 To 6) As String
Dim i As Integer
Dim j As Integer
Dim lastRow As Integer


c(1) = ("*TW747*")
c(2) = ("*TW691*")
c(3) = ("*TW2200*")
c(4) = ("*TW750*")
c(5) = ("*TW409*")
c(6) = ("*TW742*")


i = 1


With ActiveSheet
        ' Find the row that the last data line is in
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
    
    ' Loop through the data to the last row
Do While i <= lastRow
        ' Loop through the string conditions (UBound(c) giving the size of the array)
    For j = 1 To UBound(c)
            ' If there's a match, then...
        If Cells(i, 10).Value Like c(j) Then
                ' Insert blank row beneath the current one
            Cells(i + 1, 10).EntireRow.Insert shift:=xlDown
                ' Copy the values from the matching row into the blank one
            Range(Cells(i + 1, 10), Cells(i + 1, 11)).Value = Range(Cells(i, 10), Cells(i, 11)).Value
                ' Adjust loop values to account for the additional row
            lastRow = lastRow + 1
            i = i + 1
            Exit For
        End If
    Next j
    
    i = i + 1
Loop


End Sub