Excel cut-paste

[Theglyde]

I have two different excel workbook

one is work in progress, other is archived work that is done

practically, I want to open

« Work »
with my cursor select 10rows in a row, when highlighted

click on button with macro that opens « Archived »
Cuts the rows out of « work » that I selected before clicking button and paste then at the end of column A of Archived. I have all coding that opens, that saves and closes... I have also code that will find last row. What I am missing is how tu cut out the info I have selected before the macro button and paste it

 

[sooshil]

I am outside now and reading your post in mobile. When I get chance, I will look into it and give you a working solution.

 

[Theglyde]

no worries... Again very appreciative and happy to have found your help. I love that I saw this. I do this code in so many more lines usually seperate codes and then us a sub to Call mutliple macro’s but this in one shot so much best

meaning I open. then I do the copy paste, then I do the save and close, but all separated... much longer lol

 

[sooshil]

Hello
Try this:

Sub cut()
    Dim lastrow As Long
    Dim OpenBook As Workbook
    Application.CutCopyMode = False
    Application.ScreenUpdating = False

    Selection.Copy
    Set OpenBook = Workbooks.Open("myBook.xlsm")
    lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & lastrow).PasteSpecial xlPasteAll
    OpenBook.Close SaveChanges:=True
    Selection.Delete
    
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
End Sub

 

[sooshil]

The above code should work perfectly.
If you want to select entire row and copy that then we can check if entire row(s) is/are selected.
If entire row(s) is/are not selected, then the below code will display a message asking user to select at least one entire row. The data will only be copied if entire row(s) is/are selected.
Here is the code:

Sub cut()
    Dim lastrow As Long
    Dim OpenBook As Workbook
    Dim NumCols As Long
    Dim Answer As VbMsgBoxResult
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
    
    NumCols = Selection.Columns.Count
    If NumCols <> 16384 Then
        Answer = MsgBox("It looks like you are not selecting entire row(s)." & vbNewLine & _
        "Please select at least one entire row to proceed.", vbOKOnly, "Selection Invalid...")
        Application.ScreenUpdating = True
        Application.CutCopyMode = True
        Exit Sub
    Else
        Selection.Copy
        Set OpenBook = Workbooks.Open("C:\Users\sushi\Documents\myBook.xlsm")
        lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
        Range("A" & lastrow).PasteSpecial xlPasteAll
        OpenBook.Close SaveChanges:=True
        Selection.Delete
    End If
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
End Sub

 

[Theglyde]

Hello
Try this:

Sub cut()
    Dim lastrow As Long
    Dim OpenBook As Workbook
    Application.CutCopyMode = False
    Application.ScreenUpdating = False

    Selection.Copy
    Set OpenBook = Workbooks.Open("myBook.xlsm")
    lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & lastrow).PasteSpecial xlPasteAll
    OpenBook.Close SaveChanges:=True
    Selection.Delete
   
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
End Sub

OMG ? you are so amazing!!! been on this for 6hrs atlease... tried so many version. So many were close but this one is working... Thank you

 

[sooshil]

Glad to know, you found a working solution. ?