VBA - Divide rows based on condition

[Auctor Somnium]

My office version is 365 in case that's relevant.
I never posted a question in this forum so sorry if my explanation isn't good enough.

This sheet is just to ilustrate, none of this is what is actually in my sheet but it is similar to what I need to do.

My objective is to split a row based if in "Type", "RD/Ready" shows up. If it does I want a new row to be made underneath the original one.

There are some criterias to this:
- The sheet will only have more rows as time goes on so it would be good if this macro is able to work on future rows as well;
- The values from the columns that aren't marked would just be duplicated to the new row created;
- In Row 2: Type should have only "Ready" written in column "F"and Row 1 should change to only "RD";
- In Row 1: Columns "Production Ready", "Total Cost Ready" should have set to 0 and that should happen to "Production RD", "Total Cost Ready" in Row 2.

OBS:
I called the original row as Row 1 and the row that should be created as Row 2 to facilitate in explaining

 

[DropTables]

I think you want something like this. The below code should work if the spreadsheet is set up exactly like the one you provide, but will break if any of the columns are moved around.

Sub SplitRow()
Dim WB As Workbook
Set WB = Application.ActiveWorkbook
    Dim WS As Worksheet
    Set WS = WB.ActiveSheet
    
Dim i As Long
Dim NumofRows As Long

NumofRows = WS.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To NumofRows
    If WS.Range("F" & i).Value = "RD/Ready" Then
        WS.Range("F" & i + 1).EntireRow.Insert
         WS.Range("A" & i + 1 & ":" & "F" & i + 1).Value = WS.Range("A" & i & ":" & "F" & i).Value
         WS.Range("N" & i + 1 & ":" & "O" & i + 1).Value = WS.Range("A" & i & ":" & "F" & i).Value
         WS.Range("F" & i).Value = "RD"
         WS.Range("H" & i).Value = 0
         WS.Range("L" & i).Value = 0
         WS.Range("F" & i + 1).Value = "Ready"
         WS.Range("G" & i +1).Value = 0
         WS.Range("L" & i + 1).Value = 0
         
    Else: End If
Next
        
End Sub

 

[DropTables]

Let me know how it works for you. It checks each row for "RD/Ready" and then takes actions if it finds it. You should be able to run it as many times as you want as you insert new data and it will just ignore rows it has already split.

 

[DropTables]

I think you want something like this. The below code should work if the spreadsheet is set up exactly like the one you provide, but will break if any of the columns are moved around.

Sub SplitRow()
Dim WB As Workbook
Set WB = Application.ActiveWorkbook
    Dim WS As Worksheet
    Set WS = WB.ActiveSheet
   
Dim i As Long
Dim NumofRows As Long

NumofRows = WS.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To NumofRows
    If WS.Range("F" & i).Value = "RD/Ready" Then
        WS.Range("F" & i + 1).EntireRow.Insert
         WS.Range("A" & i + 1 & ":" & "F" & i + 1).Value = WS.Range("A" & i & ":" & "F" & i).Value
         WS.Range("N" & i + 1 & ":" & "O" & i + 1).Value = WS.Range("N" & i & ":" & "O" & i).Value
         WS.Range("F" & i).Value = "RD"
         WS.Range("H" & i).Value = 0
         WS.Range("L" & i).Value = 0
         WS.Range("F" & i + 1).Value = "Ready"
         WS.Range("G" & i +1).Value = 0
         WS.Range("L" & i + 1).Value = 0
        
    Else: End If
Next
       
End Sub

Corrected a type=o

 

[Auctor Somnium]

This is nearly exactly what I needed there were a few things I had to add to make it work in the sheet I made because the values weren't copying the way they should in the created Row.
Thanks so much it really helped I'm going to adapt it to the actual spreadsheet now

 

[DropTables]

Sorry it was a bit of a rush job, glad you were able to work out the kinks.

 

[Auctor Somnium]

Yeah it worked, but for some reason in the actual sheet it isn't altering lines above 5175, I really don't know why

 

[Auctor Somnium]

It works if I run it again I think it's to do with the limits of the computer im using