title: Consolidating two Macros into One
body: <p>I have two similar macros I've written, and for efficiency's sake I'd like to consolidate them into one. The first macro adds 4 blank rows on another tab underneath a specific row, where column C matches certain criteria. The second macro copies 4 rows of data from an existing tab over to the new tab, and pastes that data into the 4 newly created blank rows. Any help would be greatly appreciated! Thank you</p>
  
  <p>Conceptual screenshots attached: 
  Screenshot 1: <a href="https://i.stack.imgur.com/W0Van.png" rel="nofollow noreferrer">Initial State</a>
  Screenshot 2: <a href="https://i.stack.imgur.com/TpdM2.png" rel="nofollow noreferrer">MACRO 1 inserts 4 rows if criteria in column C is met (in this case value = "Part A"</a>
  Screenshot 3: <a href="https://i.stack.imgur.com/7dNlU.png" rel="nofollow noreferrer">MACRO 2 pulls in row data from another sheet and pastes it into the new blank rows on this sheet</a></p>
  
  <p>FIRST MACRO:</p>
  
  <pre><code>Sub RowAdder_01()
  
  Dim Col As Variant
  Dim BlankRows As Long
  Dim LastRow As Long
  Dim R As Long
  Dim StartRow As Long
  Dim PN_01 As Range
  Set PN_01 = Range("M17")
  
      Col = "C"
      StartRow = 1
      BlankRows = 1
  
          LastRow = Cells(Rows.Count, Col).End(xlUp).Row
  
          Application.ScreenUpdating = False
  
          With Worksheets("NEW SHEET")
  For R = LastRow To StartRow + 1 Step -1
  If .Cells(R, Col) = PN_01 Then
  .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
  .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
  .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
  .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
  End If
  Next R
  End With
  Application.ScreenUpdating = True
  
  End Sub
  </code></pre>
  
  <p>SECOND MACRO: </p>
  
  <pre><code>Sub PasteRowData_01()
  
  Dim Col As Variant
  Dim BlankRows As Long
  Dim LastRow As Long
  Dim R As Long
  Dim StartRow As Long
  Dim PN_01 As Range
  Set PN_01 = Range("M17")
  
      Col = "C"
      Drop = "A"
      StartRow = 1
      BlankRows = 1
  
          LastRow = Cells(Rows.Count, Col).End(xlUp).Row
  
          Application.ScreenUpdating = False
  
  Sheets("OLD SHEET").Rows("54:57").SpecialCells(xlCellTypeVisible).Select
  Selection.Copy
  
      With Worksheets("NEW SHEET")
  For R = LastRow To StartRow + 1 Step -1
  If .Cells(R, Col) = PN_01 Then
     Sheets(NEW SHEET).Select
      .Cells(R + 1, Drop).Select
      Selection.PasteSpecial
  
  End If
  Next R
  End With
  Application.ScreenUpdating = True
  
  End Sub
  </code></pre>