VBA copy insert data depending on value

[plastakis]

I got a very big challenge that I tried to find on google but couldn’t find. My problem is that you need to insert rows below the main value according to the dependency. I have got such vba is it possible adapt to my needs.

Sub InsertBlankRowsBasedOnCellValue()

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "B"
StartRow = 6
BlankRows = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False

With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "insert" Then
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

I attached my project process how it look like.

 

[Joe4]

Can you provide us with some specifics, such as:

1. What is the exact location of your first list (the list of records you want to insert into the other list)?
Sheet name & range

2. What is the exact location of your second list (the list of records you want to insert the new values into)?
Sheet name & range

 

[Fluff]

How about

Sub plastakis()
   Dim Cl As Range, Fnd As Range
   
   For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
      Set Fnd = Range("E:E").Find(Cl.Value, , , xlWhole, xlByRows, xlNext, , , False)
      If Not Fnd Is Nothing Then
         Fnd.EntireRow.Insert
         Fnd.Offset(-1).Resize(, 2).Value = Cl.Resize(, 2).Value
      End If
   Next Cl
End Sub

Change ranges to suit.

 

[plastakis]

Thanks a lot for your code!! Everything will be ok, but I need that components data insert in part number sheet. Your code insert pn into components sheet. But if it impossible i would reverse all my model.

 

[Fluff]

My code was based on your image where everything is on the same sheet. If your data is not like that, then you should give accurate information in your post, otherwise it's obviously not going to work.
What are the sheet names & ranges?

 

[plastakis]

Oh sorry for inaccurate information. My basic part list is in sheet("Master parts"), the part component list is in Sheet("Components"). i hope that is possible to copy from Components sheet to Master parts. I tried adapt to my information, but i got result, that Master parts move to Components sheet.[

Sub plastakis()
   Dim Cl As Range, Fnd As Range
  
   For Each Cl In Worksheets("Master parts").Range("F2", Range("F" & Rows.Count).End(xlUp))
      Set Fnd = Worksheets("Components").Range("AZ:AZ").Find(Cl.Value, , , xlWhole, xlByRows, xlNext, , , False)
      If Not Fnd Is Nothing Then
         Fnd.EntireRow.Insert
         Fnd.Offset(-1).Resize(, 2).Value = Cl.Resize(, 2).Value
      End If
   Next Cl
End Sub

 

[Fluff]

Which sheet should have the new rows added?

 

[plastakis]

Which sheet should have the new rows added?

Master parts

 

[Fluff]

In that case you need to swap the sheet names around.

Sub plastakis()
   Dim Cl As Range, Fnd As Range
  
   For Each Cl In Worksheets("Components").Range("F2", Worksheets("Components").Range("F" & Rows.Count).End(xlUp))
      Set Fnd = Worksheets("Master parts").Range("AZ:AZ").Find(Cl.Value, , , xlWhole, xlByRows, xlNext, , , False)
      If Not Fnd Is Nothing Then
         Fnd.EntireRow.Insert
         Fnd.Offset(-1).Resize(, 2).Value = Cl.Resize(, 2).Value
      End If
   Next Cl
End Sub

 

[plastakis]

Thanks, code works perfect. Sorry for some stupid question. You solve my problem. Have a good summer