add rows at the end
Results 1 to 10 of 10

Thread: add rows at the end
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jul 2019
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default add rows at the end

    Hi everyone.
    This macro appends 2 rows after the non-blank rows at the end.
    can I change to increase the rows to 4?




    Code:
    Option Explicit
    
    
    Sub aggiungi_copiaformato_new()
    
        On Error Resume Next
        
        Dim n As Long
        Dim x As Long
        
      
            ActiveSheet.Unprotect "987654"
           
            Dim uR As Long
            
            uR = Cells(Rows.Count, 2).End(xlUp).Row
    
            Range(Cells(uR - 1, 1), Cells(uR, 1)).EntireRow.Copy
            
            Application.EnableEvents = False
            
            Cells(uR + 1, 1).PasteSpecial Paste:=xlFormats
            Range("B" & Rows.Count).End(xlUp).Offset(-1).Resize(2, 16).ClearContents
            
            Application.EnableEvents = True
            
            Application.CutCopyMode = False
            
            'Application.Goto ActiveCell, scroll:=True
            
            ActiveSheet.Protect "987654"
    
        
    End SubOption Explicit
    
    
    Sub aggiungi_copiaformato_new()
    
        On Error Resume Next
        
        Dim n As Long
        Dim x As Long
        
      
            ActiveSheet.Unprotect "987654"
           
            Dim uR As Long
            
            uR = Cells(Rows.Count, 2).End(xlUp).Row
    
            Range(Cells(uR - 1, 1), Cells(uR, 1)).EntireRow.Copy
            
            Application.EnableEvents = False
            
            Cells(uR + 1, 1).PasteSpecial Paste:=xlFormats
            Range("B" & Rows.Count).End(xlUp).Offset(-1).Resize(2, 16).ClearContents
            
            Application.EnableEvents = True
            
            Application.CutCopyMode = False
            
            'Application.Goto ActiveCell, scroll:=True
            
            ActiveSheet.Protect "987654"
    
        
    End Sub
    thank you
    john

  2. #2
    MrExcel MVP
    Moderator
    xenou's Avatar
    Join Date
    Mar 2007
    Location
    Clev. OH, USA
    Posts
    16,441
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    1 Thread(s)

    Default Re: add rows at the end

    this should work by expanding the range:

    Change this statement:
    Range(Cells(uR - 1, 1), Cells(uR, 1)).EntireRow.Copy

    Amend to this instead:
    Range(Cells(uR - 3, 1), Cells(uR, 1)).EntireRow.Copy
    Last edited by xenou; Aug 6th, 2019 at 03:53 PM.

    Using: Office 2010/Win7 (work) Office 2010/Win7 (home)

    You are rich in proportion to the number of things you can let alone.
    -- Henry David Thoreau

  3. #3
    New Member
    Join Date
    Jul 2019
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: add rows at the end

    Hi xenou
    it works.
    this
    Code:
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-1) .Resize (2, 16) .ClearContents
    delete the contents of the 2 lines.
    Now with 4 lines it does not work.
    I corrected this:
    Code:
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-3) .Resize (2, 16) .ClearContents
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-2) .Resize (2, 16) .ClearContents
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-1) .Resize (2, 16) .ClearContents
    it's right?

  4. #4
    MrExcel MVP
    Moderator
    xenou's Avatar
    Join Date
    Mar 2007
    Location
    Clev. OH, USA
    Posts
    16,441
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    1 Thread(s)

    Default Re: add rows at the end

    Okay, cool.

    Probably here you could also expand the range as well:

    Code:
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-3) .Resize (2, 16) .ClearContents
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-2) .Resize (2, 16) .ClearContents
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-1) .Resize (2, 16) .ClearContents
    try instead:

    Code:
    Range ("B" & Rows.Count) .End (xlUp) .Offset (-3) .Resize (4, 16) .ClearContents
    Note that I am guessing a bit - not tested.
    Last edited by xenou; Aug 6th, 2019 at 04:22 PM.

    Using: Office 2010/Win7 (work) Office 2010/Win7 (home)

    You are rich in proportion to the number of things you can let alone.
    -- Henry David Thoreau

  5. #5
    New Member
    Join Date
    Jul 2019
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: add rows at the end

    The new modification does not work cancels the previous 4 rows

  6. #6
    New Member
    Join Date
    Jul 2019
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: add rows at the end

    Hi xenou your change it works, my error of copy and paste.
    Thank you.
    john

  7. #7
    MrExcel MVP
    Moderator
    xenou's Avatar
    Join Date
    Mar 2007
    Location
    Clev. OH, USA
    Posts
    16,441
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    1 Thread(s)

    Default Re: add rows at the end

    Here is a rewrite we just use a variable for number of rows:
    Code:
    Sub aggiungi_copiaformato_new()
    
        On Error Resume Next
        
     
            ActiveSheet.Unprotect "987654"
           
            Dim uR As Long
            Dim NumberOfNewRows As Long
            
            
            uR = Cells(Rows.Count, 2).End(xlUp).Row
            NumberOfNewRows = 4
    
            Range(Cells(uR - (NumberOfNewRows - 1), 1), Cells(uR, 1)).EntireRow.Copy
            
            Application.EnableEvents = False
            
            Cells(uR + 1, 1).PasteSpecial Paste:=xlFormats
            
            Application.EnableEvents = True
            
            Application.CutCopyMode = False
            
            ActiveSheet.Protect "987654"
    
        
    End Sub
    However, I left out anything that involves deleting rows. Your original post said only to append blank rows so there should be nothing that needs to be deleted.

    Using: Office 2010/Win7 (work) Office 2010/Win7 (home)

    You are rich in proportion to the number of things you can let alone.
    -- Henry David Thoreau

  8. #8
    New Member
    Join Date
    Jul 2019
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: add rows at the end

    Hi xenou amazing!
    Your variable change is ok.
    I added:
    Code:
    Range("B" & Rows.Count).End(xlUp).Offset(-(NumberOfNewRows - 1)).Resize(NumberOfNewRows, 16).ClearContents '<<< variabile
    Code:
    Option Explicit
    
    
    Sub aggiungi_copiaformato_new()
    
        On Error Resume Next
        
        Dim n As Long
        Dim x As Long
       
            ActiveSheet.Unprotect "987654"
           
            Dim uR As Long
            Dim NumberOfNewRows As Long
             
            uR = Cells(Rows.Count, 2).End(xlUp).Row
            NumberOfNewRows = 12
            
            'Range(Cells(uR - 1, 1), Cells(uR, 1)).EntireRow.Copy '<<< 2 righe
            Range(Cells(uR - 3, 1), Cells(uR, 1)).EntireRow.Copy '<<< 4 righe
            Range(Cells(uR - (NumberOfNewRows - 1), 1), Cells(uR, 1)).EntireRow.Copy '<<< variabile
            
            Application.EnableEvents = False
            
            Cells(uR + 1, 1).PasteSpecial Paste:=xlFormats
            Cells(uR + 1, 1).PasteSpecial Paste:=xlFormulas
            Cells(uR + 1, 1).PasteSpecial Paste:=xlPasteValidation
            
            'Range(Cells(uR, 2), Cells(uR + 2, 12)).ClearContents
            'Range("B" & Rows.Count).End(xlUp).Offset(-1).Resize(2, 16).ClearContents '<<<2 righe
            'Range("B" & Rows.Count).End(xlUp).Offset(-3).Resize(4, 16).ClearContents '<<< 4 righe
            Range("B" & Rows.Count).End(xlUp).Offset(-(NumberOfNewRows - 1)).Resize(NumberOfNewRows, 16).ClearContents '<<< variabile
            
            Application.EnableEvents = True
            
            Application.CutCopyMode = False
            
            Application.Goto ActiveCell, scroll:=True
            
            ActiveSheet.Protect "987654"
            
        'End If
        
    End Sub
    thank you.
    john

  9. #9
    MrExcel MVP
    Moderator
    xenou's Avatar
    Join Date
    Mar 2007
    Location
    Clev. OH, USA
    Posts
    16,441
    Post Thanks / Like
    Mentioned
    11 Post(s)
    Tagged
    1 Thread(s)

    Default Re: add rows at the end

    cool. good luck with your project.

    Using: Office 2010/Win7 (work) Office 2010/Win7 (home)

    You are rich in proportion to the number of things you can let alone.
    -- Henry David Thoreau

  10. #10
    New Member
    Join Date
    Jul 2019
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: add rows at the end

    Hi xenou,
    Your macro works, just a modification.
    Now in the attached workbook it is set to 10 lines.
    If I add 10 lines, the macro copies line 5 but there are only 9 lines to copy.
    Is it possible to lock the macro?
    I hope I explained myself

    Code:
    Sub aggiungi_copiaformato_new()
    
        On Error Resume Next
        
        Dim n As Long
        Dim x As Long
        Dim Avviso As String
        
        
        Dim rw As Range
        
    '
    
            ActiveSheet.Unprotect "987654"
           
            Dim uR As Long
            Dim NumberOfNewRows As Long
             
            uR = Cells(Rows.Count, 2).End(xlUp).Row
            NumberOfNewRows = 10
            
            'Range(Cells(uR - 1, 1), Cells(uR, 1)).EntireRow.Copy '<<< 2 righe
            Range(Cells(uR - 3, 1), Cells(uR, 1)).EntireRow.Copy '<<< 4 righe
            Range(Cells(uR - (NumberOfNewRows - 1), 1), Cells(uR, 1)).EntireRow.Copy '<<< variabile
            
            Application.EnableEvents = False
            
            Cells(uR + 1, 1).PasteSpecial Paste:=xlFormats
            Cells(uR + 1, 1).PasteSpecial Paste:=xlFormulas
            Cells(uR + 1, 1).PasteSpecial Paste:=xlPasteValidation
            
            'Range(Cells(uR, 2), Cells(uR + 2, 12)).ClearContents
            'Range("B" & Rows.Count).End(xlUp).Offset(-1).Resize(2, 16).ClearContents '<<<2 righe
            'Range("B" & Rows.Count).End(xlUp).Offset(-3).Resize(4, 16).ClearContents '<<< 4 righe
            Range("B" & Rows.Count).End(xlUp).Offset(-(NumberOfNewRows - 1)).Resize(NumberOfNewRows, 16).ClearContents '<<< variabile
            
    
       
            
            Application.EnableEvents = True
            
            Application.CutCopyMode = False
            
            Application.GoTo ActiveCell, scroll:=True
            
            ActiveSheet.Protect "987654"
            
            
    
            
            
        'End If
        
    End Sub
    not how to insert an attachment.
    john

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •