excel vložení více řádků - makro

[Ada_holubova]

Ahoj,
řeším pracovní problém, kdy potřebuji v důsledku nespojitosti dat vložit více řádků najednou, avšak v souboru s více jak 500 řádky. Konkrétně mi jde o to, že potřebuji pod každý existující řádek vložit např 3 volné řádky (počet řádků které se dají vkládat musí být měnitelný). Zatím jsem našla vždy makro, které umí vkládát jen jeden volný řádek. Mohl by jste mi s tím prosím někdo pomoci?
Děkuji moc

[Reklama]

[cmuch]

Ahoj,
tady je makro co by to mohlo splňovat

Kód: Vybrat vše

Sub PasteRows()
 Dim CalcMode As Long, EnableMode As Long, ScreenMode As Long
 Dim lastrow As Integer, i As Integer
 Dim pasterow As Byte, n As Byte
 
 'kolik radku vlozit
 pasterow = InputBox("Kolik řádků vložit?", "Info", 0)

 'puvodni nastaveni excelu
 With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    EnableMode = .EnableEvents
    .EnableEvents = False
    ScreenMode = .ScreenUpdating
    .ScreenUpdating = False
 End With
 
 'prace s aktivnim listem
 With ActiveSheet
    'posledni radek v sl.A
    lastrow = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
    'opakuj pro vsechny radky
    For i = lastrow To 1 Step -1
        'opakuj pocet vlozeni
        For n = 1 To pasterow
            'vlozeni radku za puvodni radek
            .Rows(i + 1).EntireRow.Insert
        Next n
    Next i
 End With
 'vraceni nastaveni excelu
 With Application
    .Calculation = CalcMode
    .EnableEvents = EnableMode
    .ScreenUpdating = ScreenMode
 End With
End Sub