Moving rows upwards ... one at a time

[fluffynicesheep]

Hi,

I currently have some code that looks at data in row 2 of a worksheet. After pressing a button, the VBA pulls the information from the cells in that particular row, through to other cells in the workbook, it then automatically saves this info as a new document and then returns to the first worksheet and moves the data upwards, so that row 3 has now become row 2 etc....

Basically I can't delete row 1 or row 2, as this will mess up all the formulas in the other tabs ... so found this to be the best way of doing it!.

Sure enough the first time I press the button, it does everything I want ... all the info in row 2 goes into the correct cells in other parts of the workbook, it then saves the document, returns to the original page, and the subsequent rows all move up 1 - meaning row 2 disappears and row 3 becomes the new row 2 ... so the new lot of data is now present throughout the rest of the workbook.


However, when I run the VBA for a 2nd time it now runs as normal, it saves the document with the new name, but it now stops on this line ......

.Range("A2:MN" & LastRow - 1).Value = .Range("A3:MN" & LastRow).Value

So there's some issues with moving up the rows again!!

Not sure why this is any different from the first time I have pressed the button ... so consider myself stumped!!

If anyone has any ideas that would be great.

This is the full code that I have:

Sub Rectangle3_Click()
Dim wbA As Workbook
Dim wbB As Workbook
Dim strFileName As String
Dim DataSheet As Worksheet
Dim MyRange As Range
Dim LastRow As Long


Set DataSheet = Sheets("AEB - Copy Values")
With DataSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastRow = 2 Then Exit Sub


    Application.ScreenUpdating = False

    Set wbA = ThisWorkbook

    wbA.Sheets("NCS - Copy Values Skip Blanks").Visible = True
    
    wbA.Sheets("NCS - Copy Values Skip Blanks").Copy

    Set wbB = ActiveWorkbook

    With wbB
    
        With .Sheets(1).UsedRange
            .Copy
            .PasteSpecial xlValues
            .PasteSpecial xlFormats
        End With
        
        Dim nm As Name
Dim DeleteCount As Long

'Loop through each name and delete
  For Each nm In ActiveWorkbook.Names
    On Error GoTo Skip
    
    If SkipPrintAreas = True And Right(nm.Name, 10) = "Print_Area" Then GoTo Skip
    
    nm.Delete
    DeleteCount = DeleteCount + 1

Skip:
    
  Next
  
'Reset Error Handler
  On Error GoTo 0
     
'Report Result
  If DeleteCount = 1 Then
    MsgBox "[1] name was removed from this workbook."
  Else
    MsgBox "[" & DeleteCount & "] names were removed from this workbook."
  End If


        Application.CutCopyMode = False

        strFileName = .Sheets(1).Range("FW9").Value

        .SaveAs wbA.Path & Application.PathSeparator & strFileName & ".xlsb", xlExcel12
        .Close SaveChanges:=False
    End With
    wbA.Sheets("NCS - Copy Values Skip Blanks").Visible = False
    Sheets("AEB - Copy Values").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Cells(1, 1).Activate
ActiveCell.Next.Select
Application.ScreenUpdating = True


Application.ScreenUpdating = False
.Range("A2:MN" & LastRow - 1).Value = .Range("A3:MN" & LastRow).Value
.Range("A" & LastRow & ":MN" & LastRow).ClearContents
Application.ScreenUpdating = True
End With
End Sub

 

[fluffynicesheep]

That's amazing Dante ... thank you!

 

[DanteAmor]

Im glad to help you. Thanks for the feedback.