1 year ago

#370690

test-img

sivior

Copy and insert rows for specific sheets and ranges

i have following code which copies the Row 42 and insert it a number of times below it on all the sheets

now i was wondering is there an easy fix that i can do the same but instead of all sheets at once i can choose in the code what sheets what to copy and where to insert?

Option Explicit

Sub AddRows()
    
    Const CopyRow As Long = 42
    
    Dim xCount As Variant
    Do
        xCount = Application.InputBox("Aantal rijen", "VERKOPEN DIE HANDEL", , , , , , 1)
        If TypeName(xCount) = "Boolean" Then
            MsgBox "You canceled.", vbExclamation
            Exit Sub
        End If
        If xCount < 1 Then
            MsgBox "the entered number of rows is to small, please enter again", vbCritical, "testing"
        Else
            Exit Do
        End If
    Loop
    
    Dim ash As Object: Set ash = activesheet
    Dim wb As Workbook: Set wb = ash.Parent
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim wsCount As Long
    
    For Each ws In wb.Worksheets
        wsCount = wsCount + 1
        With ws.Rows(CopyRow)
            .Copy
            .Offset(-1).Resize(xCount).Insert xlShiftDown, xlFormatFromLeftOrAbove
        End With
    Next ws
    
    Dim MsgString As String
    MsgString = "Worksheets processed: " & wsCount
    
    If wsCount > 0 Then
        Application.CutCopyMode = False
        ash.Select
        MsgString = MsgString & vbLf & "Rows inserted: " & xCount
    End If
    
    Application.ScreenUpdating = True
    
    MsgBox MsgString, vbInformation
    
End Sub

excel

vba

insert

copy

rows

0 Answers

Your Answer

Accepted video resources