Copy current row columns D through O to the line below

[drhatmrexcel]

I’ve been stumbling a bit on this and perhaps someone can get me started on the right direction to finish this small bit of code.

My spreadsheet has a sheet tab called “Master Registration Sheet”.
The first two rows are headers and then the next 2002 rows are where I have space for 2000 lines of participant entries.
Columns A, B , C and Dare columns that I have reserved for row numbers, event number and participant event number respectively.
I use columns E through O to enter participant name, address and other information relative to that participant.
As some participants enter multiple events I am trying to create a macro which after I enter a participants information on a line (between rows 3 and 2001) I can run the macro to duplicate the information in columns D through O of the current row down to the row immediately below the current row thereby saving me having to retype it. And also maybe do a multi-duplicate for participants that are entering numerous events.
I have the below code which does duplicate the entire current line to the line below (or multiple lines if I enable the entire code), however I don’t need the contents of columns A, B, C and D of the current row copied down.
So perhaps someone can recommend macro code selecting and copying a “range” of cells in columns E through O of the current row and pasting it in the row immediately below. And yes I am aware of the danger that perhaps the line below the current line may already have data in it which would be overwritten but I am not too concerned about that.

<font face=Calibri><br><SPAN style="color:#00007F">Sub</SPAN> versionthree()<br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">' versionthree Macro</SPAN><br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">'This macro copies entire row contents from current cursor position row to the row below the current row</SPAN><br><br><SPAN style="color:#007F00">'I still need it to limit the copy area to the cell in columns "E" through "O" of the current row</SPAN><br><br><SPAN style="color:#00007F">If</SPAN> ActiveSheet.Name <> "Master Registration Sheet" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>****Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br> <br><SPAN style="color:#00007F">Set</SPAN> s = Selection<br><br>** <SPAN style="color:#00007F">If</SPAN> s.Row < 3 <SPAN style="color:#00007F">Or</SPAN> s.Row + nrows > 2002 <SPAN style="color:#00007F">Then</SPAN><br>****MsgBox "You must copy rows within 3:2002 only"<br>****<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>****<br>****<br>****ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow<br><br>****<SPAN style="color:#007F00">'MAKE THE FOLLOWING ROW ACTIVE FOR COPYING DOWN TWO ROWS</SPAN><br><SPAN style="color:#007F00">'****ActiveCell.EntireRow.Copy ActiveCell.Offset(2, 0).EntireRow</SPAN><br><br>****<SPAN style="color:#007F00">'MAKE THE FOLLOWING ROW ACTIVE FOR COPYING DOWN THIRD ROW</SPAN><br><SPAN style="color:#007F00">'****ActiveCell.EntireRow.Copy ActiveCell.Offset(3, 0).EntireRow</SPAN><br><br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br><br><br><br><br><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[My Aswer Is This]

You should remove all that text from the code box and repost this code.
I cannot read this code.

 

[wideboydixon]

Note sure what happened to your code there! Give this a try:

Public Sub CopyCurrentData()

Dim thisRow As Long
thisRow = ActiveCell.Row
If thisRow < 3 Or thisRow > 2001 Then Exit Sub

Dim numberOfCopies As Long
numberOfCopies = CLng(InputBox("How many copies?", "Copy Current Data", "1"))
If numberOfCopies < 1 Then Exit Sub
If thisRow + numberOfCopies > 2002 Then numberOfCopies = 2002 - thisRow

Dim copyRange As Range
Set copyRange = Range(Cells(thisRow, "E"), Cells(thisRow, "O"))

copyRange.Copy Destination:=copyRange.Offset(1, 0).Resize(numberOfCopies)

End Sub

WBD

 

[drhatmrexcel]

Okey dokey, that is great. SO now the lady that does the data input will not be typing so much. I am gonna add a button so that way since she is a mouse person then she won't have to use a keyboard short cut.

Thanks so much wideboy. Now I gotta figure out why when I used the VBE HTML maker to copy the code to the clip board and then pasted it in the code box the final product was all of the code with all of the html tags too.

 

[wideboydixon]

You don't need to use a plug-in; you can just copy and paste the code between

 tags.

WBD

 

[MARK858]

Now I gotta figure out why when I used the VBE HTML maker to copy the code to the clip board and then pasted it in the code box the final product was all of the code with all of the html tags too.

Use the convert as BB Option then change the [face=Courier New] to [code=rich] and the [/face] to [/code]. Don't put it in any other code tags and it should look like the code below.

Public Sub CopyCurrentData()

    Dim thisRow As Long
    thisRow = ActiveCell.Row
    If thisRow < 3 Or thisRow > 2001 Then Exit Sub

    Dim numberOfCopies As Long
    numberOfCopies = CLng(InputBox("How many copies?", "Copy Current Data", "1"))
    If numberOfCopies < 1 Then Exit Sub
    If thisRow + numberOfCopies > 2002 Then numberOfCopies = 2002 - thisRow
    ' test line to show commented code
    Dim copyRange As Range
    Set copyRange = Range(Cells(thisRow, "E"), Cells(thisRow, "O"))

    copyRange.Copy Destination:=copyRange.Offset(1, 0).Resize(numberOfCopies)

End Sub

 

[drhatmrexcel]

Here is the macro code that worked for me to make a copy of the contents of columns E through the right hand edge of the sheet of the current row where the active cell is currently located and pasting it in the row directly below. But the code does not work if the current active cell is in rows 1 or 2 or in rows 2002 or greater.

Sub OneCopy()
'
' OneCopy Macro
'
Dim thisRow As Long
thisRow = ActiveCell.Row
If thisRow < 3 Or thisRow > 2001 Then Exit Sub
Dim numberOfCopies As Long
numberOfCopies = 1
If numberOfCopies < 1 Then Exit Sub
If thisRow + numberOfCopies > 2002 Then numberOfCopies = 2002 - thisRow
Dim copyRange As Range
Set copyRange = Range(Cells(thisRow, "E"), Cells(thisRow, "O"))
copyRange.Copy Destination:=copyRange.Offset(1, 0).Resize(numberOfCopies)

'
End Sub

Here is the macro code that worked for me to make a copy of the contents of columns E through the right hand edge of the sheet of the current row where the active cell is currently located and pasting it into the two rows directly below. But the code does not work if the current active cell is in rows 1 or 2 or in rows 2002 or greater. You can change the limit of the rows by changing the If thisRow < 3 Or thisRow > 2001 Then Exit Sub line

Sub TwoCopies()
'
' TwoCopies Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Dim thisRow As Long
thisRow = ActiveCell.Row
If thisRow < 3 Or thisRow > 2001 Then Exit Sub
Dim numberOfCopies As Long
numberOfCopies = 2
If numberOfCopies < 1 Then Exit Sub
If thisRow + numberOfCopies > 2002 Then numberOfCopies = 2002 - thisRow
Dim copyRange As Range
Set copyRange = Range(Cells(thisRow, "E"), Cells(thisRow, "O"))
copyRange.Copy Destination:=copyRange.Offset(1, 0).Resize(numberOfCopies)

End Sub