Question

我的Excel中只有几张纸。我希望此代码应用某些特定的工作表。由于我不擅长vba，因此无法执行。请有人帮我。如何将Sheet3添加到此代码中的17，以便仅针对这些工作表运行代码。

Sub insertRowsSheets()
    ' Disable Excel properties before macro runs
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    ' Declare object variables
    Dim ws As Worksheet, iCountRows As Integer
    Dim activeSheet As Worksheet, activeRow As Long
    Dim startSheet As String
        
  ' State activeRow
    activeRow = ActiveCell.Row
    
 ' Save initial active sheet selection
    startSheet = ThisWorkbook.activeSheet.Name
               
    ' Trigger input message to appear - in terms of how many rows to insert
    iCountRows = 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 iCountRows = False Or iCountRows <= 0 Then End
    
    ' Loop through the worksheets in active workbook
    For Each ws In ActiveWorkbook.Sheets
        ws.Activate
        Rows(activeRow & ":" & activeRow + iCountRows - 1).Insert
        Range("A9").Select
        Range("A8:C8").Select
        Selection.Copy
        Range("A9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("D8:J8").Select
        Selection.AutoFill Destination:=Range("D8:J9")
        Range("D8:J9").Select
        Range("K8:L8").Select
        Selection.Copy
        Range("K9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("M8:T8").Select
        Selection.AutoFill Destination:=Range("M8:T9")
        Range("M8:T9").Select
        Range("A8").Select
    Next ws
                            
    ' Move cursor back to intial worksheet
    Worksheets(startSheet).Select
    Range("A8").Select
                   
    ' Re-enable Excel properties once macro is complete
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With                                     
End Sub

Answer 1

更新工作表

这应该和以前一样。
至少它应该可以帮助您找出如何遍历工作表名称数组而不是工作表集合的方法。
我不知道复制和填写的逻辑。您是否应该从活动行开始填充与用户选择的行一样多的行？

代码

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

Answer 2

' Loop through the worksheets in active workbook
For i = 3 To 17 Step 1 'This runs from the 3rd Sheet to the 17th irrespective of the name. Use array method if the sheets are mixed up
    If WorksheetIDExists(i, ActiveWorkbook) Then
        Set ws = ActiveWorkbook.Worksheets(i)
        With ws
            .Rows(activeRow & ":" & activeRow + iCountRows - 1).Insert '<- Kindly note that, if the active row is above A8, the whole script becomes a mess
            .Range("A8:C8").Copy
            .Range("A9").PasteSpecial Paste:=xlPasteValues
            .Range("D8:J9").FillDown
            .Range("K8:L8").Copy
            .Range("K9").PasteSpecial Paste:=xlPasteValues
            .Range("M8:T8").FillDown
            .Range("A8").Select
        End With
    End If
Next i

也添加此功能。

Function WorksheetIDExists(shtid As Integer, wb As Workbook) As Boolean
    Dim sht As Worksheet
    On Error Resume Next
    Set sht = wb.Worksheets(shtid)
    On Error GoTo 0
    WorksheetIDExists = Not sht Is Nothing
End Function

有什么办法可以在VBA Excel中修复此循环？

2 个答案:

更新工作表