Macro to copy active row and paste in row below

[Raceman]

Hello:

I need help with a macro to Copy the active row and paste it in the row below. The following is more detail on what I want to do-

• Copied cell A (a number) will increase by 1 in the pasted cell A, all other pasted cells will be exactly as in row above (but some of these cells will change in the next step).
• Pasted cells B, D, F, G, and H will change. Cell B's last 3 numbers are "-100" (example: 1234567-100) and need to change to "-600" (ex: 1234567-600), D needs to change to "N/A", cell F inserts the word "test" in front of what was pasted, in cell G, replace it with value from cell B from copied row, and in cell H, replace it with value from cell F from copied row.

Below is the macro I've been using, but the only thing it does is copy the active row and paste it below it. All numbers increase by 1 (which is only desired in cell A), and I need to make the changes to pasted cells B,D,F,G, and H manually. I also do not necessarily want it to ask me how many rows to add either, it will always be one (1).

I would greatly appreciate your suggestions,
Thank you,
Raceman

Sub Button1_Click()
' Insert Rows
   ' row selection based on active cell
   Dim x As Long
   ActiveCell.EntireRow.Select  'So you do not have to preselect entire row
   If vRows = 0 Then
    vRows = Application.InputBox(prompt:= _
      "How many rows do you want to add?", Title:="Add Rows", _
      Default:=1, Type:=1) 'Default for 1 row, type 1 is number
    If vRows = False Then Exit Sub
   End If
   'if you just want to add cells and not entire rows
   'then delete ".EntireRow" in the following line
   Dim sht As Worksheet, shts() As String, i As Long
   ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
       Windows(1).SelectedSheets.Count)
   i = 0
   For Each sht In _
       Application.ActiveWorkbook.Windows(1).SelectedSheets
    Sheets(sht.Name).Select
    i = i + 1
    shts(i) = sht.Name
    x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
    Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
     Resize(rowsize:=vRows).Insert Shift:=xlDown
    Selection.AutoFill Selection.Resize( _
     rowsize:=vRows + 1), xlFillDefault
    On Error Resume Next    'to handle no constants in range
    ' to remove the non-formulas
   ' Selection.Offset(1).Resize(vRows).EntireRow. _
    ' SpecialCells(xlConstants).ClearContents
   Next sht
  Worksheets(shts).Select
End Sub