is there any way to fix this loop in vba excel?

Update Worksheets

• This should work the same way as before.
• At least it should help you to figure out how to loop through an array of worksheet names instead of the worksheets collection.
• I could not figure out the logic of copying and filling. Shouldn’t you be filling as many rows as the user selected starting from the active row?

The Code

Option Explicit

Sub insertRowsSheets()
    
    ' Define Worksheet Names Array.
    Dim wsNames As Variant ' Tab names, not code names.
    wsNames = Array("Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", _
                    "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12", _
                    "Sheet13", "Sheet14", "Sheet15", "Sheet16", "Sheet17")
    
    ' Declare object variables
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Dim RowsCount As Long
    Dim ActiveRow As Long
    Dim StartSheet As String
    Dim i As Long
        
    ' Define workbook.
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' State activeRow
    ActiveRow = ActiveCell.Row
    
    ' Trigger input message to appear - in terms of how many rows to insert
    RowsCount = Application.InputBox(Prompt:="How many rows do you want to insert, starting with row " _
    & ActiveRow & "?", Type:=1)
        
    ' Error handling - end the macro if a zero, negative integer or non-integer value is entered
    If RowsCount = False Or RowsCount <= 0 Then Exit Sub
    
    ' Loop through the worksheets.
    For i = LBound(wsNames) To UBound(wsNames)
        With wb.Worksheets(wsNames(i))
            .Rows(ActiveRow & ":" & ActiveRow + RowsCount - 1).Insert
            .Range("A9:C9").Value = .Range("A8:C8").Value
            .Range("D8:J8").AutoFill Destination:=.Range("D8:J9")
            .Range("K9:L9").Value = .Range("K8:L8").Value
            .Range("M8:T8").AutoFill Destination:=.Range("M8:T9")
        End With
    Next i
                   
End Sub