VBA Copy row and insert copy of row below into active sheet and insert row into another sheet

M4TVD

New Member
Joined
Mar 23, 2021
Messages
25
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have a workbook that I already have a large amount of VBA code in, running a multitude of functions. One of these is to copy the data in row that contains the active cell and insert a row with this data into the row below. I need to add to this code to insert a row (must be the same row as being inserted into the active sheet) into another sheet in the same workbook.

For example if I have cell D175 as active cell, I click the button with the assigned VBA code, it copy's row 175 and inserts a new row into row 176 that contains the same data as row 175.

I require code adding that will also add the same row number into another sheet (call this "Build Output")

This is my current code:
VBA Code:
Sub InsertCopyOfPart()
   With ActiveCell
      .Offset(1).EntireRow.Insert
      Cells(.Row, 1).Resize(2, 13).FillDown
            
   End With
End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
19,116
Office Version
  1. 2013
Platform
  1. Windows
Try this:
VBA Code:
Sub InsertCopyOfPart()
'Modified  11/21/2021  1:50:14 PM  EST
Dim Lastrow As Long
Dim c As Long
c = ActiveCell.Column
Dim r As Long
r = ActiveCell.Row
Lastrow = Sheets("Build Output").Cells(Rows.Count, c).End(xlUp).Row
   
   
   With ActiveCell
      .Offset(1).EntireRow.Insert
      Cells(.Row, 1).Resize(2, 13).FillDown
            Rows(r).Copy Sheets("Build Output").Rows(Lastrow + 1)
   End With
Rows(r).Copy Sheets("Build Output").Rows(Lastrow + 1)

Application.ScreenUpdating = True
End Sub
 

M4TVD

New Member
Joined
Mar 23, 2021
Messages
25
Office Version
  1. 365
Platform
  1. Windows
Thankyou,

This does not do what I require as it only inserts a copy of the selected row into the bottom row of sheet "Build Output". I require it to insert a new (blank row) into the "Build Output" sheet as it is inserting into the active sheet.


I have this code also within my workbook that will remove a row from the active sheet ( in this case "ALL PARTS") cut and paste it into a different sheet in the workbook and then also delete the row (same as active row) from the "build Output Sheet". Can Any of this code be re-used to insert row instead of delete row?

VBA Code:
Sub DeadPart()
Dim Answer As String
Dim x As Long
Dim i As Long

i = ActiveCell.Row

ActiveCell.EntireRow.Cut

Answer = MsgBox("Are you sure you want to remove this part from circulation?", vbYesNo, "Dead Part?")
If Answer = vbNo Then

MsgBox "Nothing Removed"
End

Else
Sheets("Quarantine").Select
x = Range("K" & Rows.Count).End(xlUp).Row
x = x + 1
Cells(x, 1).Select
Selection.Insert Shift:=xlDown
Sheets("Build Output").Select
Rows(i).EntireRow.Delete
Sheets("Build Output (SPARE)").Select
Rows(i).EntireRow.Delete
Sheets("ALL PARTS").Select
Rows(i).EntireRow.Delete


MsgBox "Part Removed from Circulation - Now in Quarantine"
End If


End Sub
 

M4TVD

New Member
Joined
Mar 23, 2021
Messages
25
Office Version
  1. 365
Platform
  1. Windows
The most important thing that I require the code to do is to insert the new row in the same row number in both sheets, the sheets being "ALL PARTS" and "Build Output", which MUST be the row below the active cell in "ALL PARTS" sheet.
 

M4TVD

New Member
Joined
Mar 23, 2021
Messages
25
Office Version
  1. 365
Platform
  1. Windows
I found a solution, using a number of sub calls into what I have called MasterMacroInsertPart.

VBA Code:
Sub InsertCopyOfPart() 'Insert into All Parts ONLY
   With ActiveCell
      .Offset(1).EntireRow.Insert
      Cells(.Row, 1).Resize(2, 13).FillDown
            
   End With
End Sub


Sub ActiveCellSelect()
targetcell = ActiveCell.Address
OriginSheet = ActiveSheet.Name
Dim ws As Worksheet
For Each ws In Sheets
    If ws.Visible = True Then ws.Select (False)
Next ws
Range(targetcell).Select
Sheets(OriginSheet).Select
End Sub

Sub InsertCopyOfPartBuildOutput() 'Insert into Build Output ONLY
   Worksheets("Build Output").Activate
   With ActiveCell
   .Offset(1).EntireRow.Insert
      Cells(.Row, 1).Resize(2, 13).FillDown
            
   End With
End Sub

Sub InsertCopyOfPartBuildOutputSPARE() 'Insert into Build Output ONLY
   Worksheets("Build Output (SPARE)").Activate
   With ActiveCell
   .Offset(1).EntireRow.Insert
      Cells(.Row, 1).Resize(2, 13).FillDown
            
   End With
End Sub

Sub MasterMacroInsertPart() 'Combines all insert macros into one command
    Call ActiveCellSelect
    Call InsertCopyOfPart
    Call InsertCopyOfPartBuildOutput
    Call InsertCopyOfPartBuildOutputSPARE

     
End Sub

Only Problem that I have found with this combination of commands is that after I run it, It leaves me active on the "Build Output" sheet when I want to be on the "All Parts" sheet that the Buttons are on.
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
19,116
Office Version
  1. 2013
Platform
  1. Windows
Try this:
VBA Code:
Sub InsertCopyOfPart()
'Modified  11/22/2021  8:09:47 AM  EST
Application.ScreenUpdating = True
Dim r As Long
r = ActiveCell.Row
  
  
   With ActiveCell
      .Offset(1).EntireRow.Insert
      Cells(.Row, 1).Resize(2, 13).FillDown
            Sheets("Build Output").Rows(r).Insert
   End With

Application.ScreenUpdating = True
End Sub
 
Solution

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
19,116
Office Version
  1. 2013
Platform
  1. Windows
Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.
 

Forum statistics

Threads
1,175,517
Messages
5,897,895
Members
434,685
Latest member
asdf12l3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top