VBA Macro for insert new line and copy formula above line

[eddorena]

Hi @Fluff and other

Sorry for making new threads here, I have some confused with the VBA Macro for insert new line and copying the formula above.

The macro actually runs, however, not as my expecting since have a difference between Sheet1 and Sheet2, here is the macro.

Private Sub CommandButton1_Click()

On Error Resume Next
Dim iRow As Long
Dim iCount As Long
Dim i As Long

iCount = InputBox _
(Prompt:="Fill number line to insert")
iRow = InputBox _
(Prompt:="Choose the start line")

For i = 1 To iCount
ThisWorkbook.Sheets("Sheet2").Rows(iRow).EntireRow.Insert
ThisWorkbook.Sheets("Sheet2").Rows(Selection.Row - 1).Copy
ThisWorkbook.Sheets("Sheet1").Rows(iRow).EntireRow.Insert
ThisWorkbook.Sheets("Sheet1").Rows(Selection.Row - 1).Copy
Next i
End Sub

When I fill the number of insert line is 5, and choose a start the insert line from line 3, on Sheet2 the line only insert 4 lines with copying the formula above (line 2), however, in Sheet1 the line insert 5 line correctly from line 3 until 7.

There is a gap 1 line between Sheet 2 and Sheet1, I wish I can get the solution
When I fill the number of insert line is 5, and choose a start the insert line from line 3, on Sheet2 the line only insert 4 lines with copying the formula above (line 2), however, in Sheet1 the line insert 5 line correctly from line 3 until 7.

There is a gap 1 line between Sheet 2 and Sheet1, I wish I can get the solution

I Attached the file Sample

 

[mohadin]

Hi
Try

For i = iCount to 1 step 1

 

[HaHoBe]

Hi mohadin,

shouldn' it be Step - 1?

Holger

 

[eddorena]

Hi mohadin,

shouldn' it be Step - 1?

Holger

By using -1 the result still same, only Sheet1 can insert correctly and Sheet2 still minus 1

For i = iCount To 1 Step -1

 

[eddorena]

Hi @Fluff, any suggestion

 

[Skyybot]

Are you only using this on one sheet at a time? If so, try this.
Private Sub CommandButton1_Click()

On Error Resume Next
Dim iRow As Long
Dim iCount As Long
Dim i As Long

iCount = InputBox _
(Prompt:="Fill number line to insert")
iRow = InputBox _
(Prompt:="Choose the start line")

For i = 1 To iCount
ActiveSheet.Rows(iRow).EntireRow.Insert
ActiveSheet.Rows(Selection.Row - 1).Copy
Next i
End Sub

 

[HaHoBe]

Hi eddorena,

please make sure that the button works if you attach a sample file (the procedure needs to be named Click_Click instead of CommandButton1_Click).

What about this:

Private Sub Click_Click()

'On Error Resume Next
  Dim lngRow As Long
  Dim lngNrRows As Long
 
  lngNrRows = InputBox(Prompt:="Fill number line to insert")

''lngRow = InputBox _
''  (Prompt:="Choose the start line")
''
'/// getting the next free row on Sheet 2
  With ThisWorkbook.Sheets("Sheet2")
    lngRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
  End With

  With ThisWorkbook.Sheets("Sheet2")
    .Cells(lngRow - 1, "A").Resize(1, 8).Copy
    .Cells(lngRow, "A").Resize(lngNrRows, 8).Insert Shift:=xlDown
  End With
  With ThisWorkbook.Sheets("Sheet1")
    .Cells(lngRow - 1, "A").Resize(1, 8).Copy
    .Cells(lngRow, "A").Resize(lngNrRows, 8).Insert Shift:=xlDown
  End With
End Sub

I still wonder why you need to insert the copied row in your sample as the sheets do not hold further data below the formula rows.

Holger

 

[eddorena]

Hi eddorena,

please make sure that the button works if you attach a sample file (the procedure needs to be named Click_Click instead of CommandButton1_Click).

What about this:

Private Sub Click_Click()

'On Error Resume Next
  Dim lngRow As Long
  Dim lngNrRows As Long
 
  lngNrRows = InputBox(Prompt:="Fill number line to insert")

''lngRow = InputBox _
''  (Prompt:="Choose the start line")
''
'/// getting the next free row on Sheet 2
  With ThisWorkbook.Sheets("Sheet2")
    lngRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
  End With

  With ThisWorkbook.Sheets("Sheet2")
    .Cells(lngRow - 1, "A").Resize(1, 8).Copy
    .Cells(lngRow, "A").Resize(lngNrRows, 8).Insert Shift:=xlDown
  End With
  With ThisWorkbook.Sheets("Sheet1")
    .Cells(lngRow - 1, "A").Resize(1, 8).Copy
    .Cells(lngRow, "A").Resize(lngNrRows, 8).Insert Shift:=xlDown
  End With
End Sub

I still wonder why you need to insert the copied row in your sample as the sheets do not hold further data below the formula rows.

Holger

Hi @HaHoBe

Little bit modified and it's 100 WORKS , Thank You for your advice it's really helpful.

Private Sub Click_Click()
'On Error Resume Next
  Dim lngRow As Long
  Dim lngNrRows As Long
 
  lngNrRows = InputBox(Prompt:="Fill number line to insert")
  lngRow = InputBox(Prompt:="Fill number line to insert")

  With ThisWorkbook.Sheets("Sheet2")
    .Cells(lngRow - 1, "A").Resize(1, 8).Copy
    .Cells(lngRow, "A").Resize(lngNrRows, 8).Insert Shift:=xlDown
  End With
  With ThisWorkbook.Sheets("Sheet1")
    .Cells(lngRow - 1, "A").Resize(1, 8).Copy
    .Cells(lngRow, "A").Resize(lngNrRows, 8).Insert Shift:=xlDown
  End With
End Sub

I Apologize about button name, I forgot change.