Change in code to copy formulas 2 other cells rather than first one?

[StargateFanFromWork]

I was so kindly given this code over a year ago by a kind poster in one of
these MS Excel ngs. I just applied it to a new spreadsheet today but
wondered why some coding I had in 2 cells wasn't being replicated. I then
remembered that it was only the formula in first cell that was repeated in
the subsequent new rows, as per the coding below since it somehow copies the
first cell.

In this new spreadsheet, all cells in A receive custom data so the first
cell doesn't need to have the formula copied. There are 2 distinct
formulas, however, in two other columns, columns D and F, that must be
replicated in any new rows. However, after studying and studying the code
below I can't figure out how to do this. Would appreciate help in this
regard.

Thanks so much in advance!! D


******************************************
Sub InsertROWS()
'

Dim i As Long
Dim j As Long
Dim k As Long

On Error GoTo dontdothat
Do
i = InputBox("How many rows do you want to insert?", "Insert Rows ",
1)
Loop Until i <> 0
Do
j = InputBox("At what Excel row number do you want to start the
insertion?", "Insert Rows", 10)
Loop Until j <> 0

k = j + i - 1
Range("" & j & ":" & k & "").Insert shift:=xlDown
j = j - 1
Range("A" & j & "").Select
Selection.AutoFill Destination:=Range("A" & j & ":A" & k & ""),
Type:=xlFillDefault
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Exit Sub

dontdothat:

End Sub
******************************************

 

[Tom Ogilvy]

Sub InsertROWS()
'

Dim i As Long
Dim j As Long
Dim k As Long

On Error GoTo dontdothat
Do
i = InputBox("How many rows do you want to insert?", "Insert Rows ",
1)
Loop Until i <> 0
Do
j = InputBox("At what Excel row number do you want to start the
insertion?", "Insert Rows", 10)
Loop Until j <> 0

k = j + i - 1
Range("" & j & ":" & k & "").Insert shift:=xlDown
j = j - 1
Range("D" & j & "").Select
Selection.AutoFill Destination:=Range("D" & j & "" & k & ""),
Type:=xlFillDefault
Range("F" & j & "").Select
Selection.AutoFill Destination:=Range("F" & j & ":F" & k & ""),
Type:=xlFillDefault
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Exit Sub

dontdothat:

End Sub


would be my guess

Clean up the word wrap.

 

[Roman]

I've tried remake it, hopefully it's OK now:

Sub InsertROWS()
' Dim i As Long
Dim j As Long
Dim k As Long
On Error GoTo dontdothat
Do
i = InputBox("How many rows do you want to insert?", "Insert Rows
", 1)
Loop Until i <> 0
Do
j = InputBox("At what Excel row number do you want to start the
insertion?", "Insert Rows", 10)
Loop Until j <> 0

k = j + i - 1
Range("" & j & ":" & k & "").Insert shift:=xlDown
j = j - 1

Range("D" & j & "").Select
Selection.AutoFill Destination:=Range("D" & j & "" & k & ""),
Type:=xlFillDefault

Range("E" & j & "").Select
Selection.AutoFill Destination:=Range("E" & j & ":E" & k & ""),
Type:=xlFillDefault

Range("E2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Exit Sub
dontdothat:
End Sub

 

[StargateFanFromWork]

That worked perfectly, Tom! Thank you, thank you <g>. Now that I have two
sets of code, the original and yours below, I have a base to compare and now
I should be able to modify any future applications of this macro for
differing situations.

Thanks so much! D

 

[StargateFanFromWork]

Thanks so much, appreciate your attempt. This one didn't actually work but
Tom Ogilvy kindly provided some code that did. It'll be neat to compare
between the two. Maybe I have enough elementary vb to figure out on my own
what each attempt does. Now that I have these and the original code that
we've modified from, I should be able to handle future situations where
other cells are involved.

Thanks once again! D

 

[Dana DeLouis]

I think this is similar to Tom's excellent idea.

Sub Demo()
Dim StartRow As Long
Dim NumberOfRows As Long

StartRow = InputBox("Starting Row?")
NumberOfRows = InputBox("How many Rows to insert?")

Rows(StartRow).Resize(NumberOfRows).Insert
Cells(StartRow - 1, "D").Resize(NumberOfRows + 1).FillDown
Cells(StartRow - 1, "F").Resize(NumberOfRows + 1).FillDown
End Sub

HTH