How do I automatically insert blanklines in a macro

[ghrek]

I have a macro and it is only copy and pasting over cells that have data in it. This is OK but im trying to also put in blank lines too.

How do I do this? Ideally I would like to insert 100 blank lines after the last entry carried forward.

 

[rollis13]

Do you mind showing your macro ? How can we modify it if we have no knowledge of it.

 

[ghrek]

Sorry Here they are and at present got as 2 seperate macro's, Both below

Sub MonthEnd()
    Dim rCl As Range, rDelete As Range
    Dim sSht As String

    sSht = InputBox("Enter new sheet name", "New Month Sheet")

    If Len(sSht) = 0 Then
        MsgBox "You must enter a name for the new sheet", vbCritical, "Quitting"
        Exit Sub
        ''/// copy current sheet
    Else: ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = sSht
        For Each rCl In ActiveSheet.Range("Y10:Y9999").Cells
            If rCl.Value = 0 Then
                If rDelete Is Nothing Then
                    Set rDelete = Range("A" & rCl.Row, rCl)
                Else: Set rDelete = Union(rDelete, Range("A" & rCl.Row, rCl))
                End If
            End If
        Next rCl
        If Not rDelete Is Nothing Then rDelete.Delete
        MsgBox "Month End successfully completed", vbInformation, "Done"
    End If
End Sub

Sub MACRO2()
'
' MACRO2 Macro
'

'
    Range("Y10:Y3564").Select
    ActiveWindow.ScrollRow = 3549
    ActiveWindow.ScrollRow = 3542
    ActiveWindow.ScrollRow = 3440
    ActiveWindow.ScrollRow = 3146
    ActiveWindow.ScrollRow = 3063
    ActiveWindow.ScrollRow = 2979
    ActiveWindow.ScrollRow = 2717
    ActiveWindow.ScrollRow = 2417
    ActiveWindow.ScrollRow = 2257
    ActiveWindow.ScrollRow = 2110
    ActiveWindow.ScrollRow = 1049
    ActiveWindow.ScrollRow = 915
    ActiveWindow.ScrollRow = 398
    ActiveWindow.ScrollRow = 386
    ActiveWindow.ScrollRow = 373
    ActiveWindow.ScrollRow = 322
    ActiveWindow.ScrollRow = 54
    ActiveWindow.ScrollRow = 10
    Range("Y10").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=6
    Selection.Copy
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.SmallScroll Down:=-114
    ActiveWindow.ScrollRow = 1027634
    ActiveWindow.ScrollRow = 957611
    ActiveWindow.ScrollRow = 437174
    ActiveWindow.ScrollRow = 183578
    ActiveWindow.ScrollRow = 10
    Range("E10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F10:I16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-22
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-99
    ActiveWindow.ScrollRow = 995562
    ActiveWindow.ScrollRow = 10
    Range("J10:X11").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=9
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.SmallScroll Down:=-147
    ActiveWindow.ScrollRow = 859288
    ActiveWindow.ScrollRow = 73821
    ActiveWindow.SmallScroll Down:=-30
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWorkbook.Save
End Sub

 

[rollis13]

See if you can adapt this macro to your project:

Option Explicit
Sub Insert_100_Rows()
    Dim LR      As Long
    LR = Range("Y" & Rows.Count).End(xlUp).Row    'detect last used row in column Y
    Rows(LR & ":" & LR + 100).FillDown            'paste down formats & formulas (if any)
    MsgBox "Done!"
End Sub

 

[ghrek]

99% there.

It adding the lines OK but it also copy and pasting data from the last line in the screen too. I just need the blank lines only

 

[rollis13]

If you only need the formulas and formats then just add a new line of code after the .FillDown to .ClearContents of the columns that have only data in the new range starting from LR + 1.