Copy row 2 and paste it after last row of another worksheet

S

sharpeye

Board Regular
Joined
Oct 5, 2018
Messages
51
Office Version
  1. 2019
Platform
  1. Windows
I found this today on a Youtube turorial and it would save me sooooo much time if I could get it work but Im struggling.

Im using this code to sort data from 2 rows into a single row ready to be transferred to a different sheet.
At the moment, once this has run through its macro, it ends with Cut, then I go another sheet with almost the last row on another sheet showing and Paste and with it not being a full row in view, as soon as I paste, it moves up a line so Im always pasting into an empty row.

Sub FixSort()
'
' FixSort Macro
' Sorts fixture data
'
' Keyboard Shortcut: Ctrl+n
'
Range("B3").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("C7").Select
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Range("B5").Select
Selection.Cut
Range("D2").Select
ActiveSheet.Paste
Range("C5").Select
Selection.Cut
Range("G2").Select
ActiveSheet.Paste
Range("C9").Select
Selection.Cut
Range("H2").Select
ActiveSheet.Paste
Range("O5").Select
Selection.Cut
Range("I2").Select
ActiveSheet.Paste
Range("O9").Select
Selection.Cut
Range("J2").Select
ActiveSheet.Paste
Range("D5").Select
Selection.Cut
Range("L2").Select
ActiveSheet.Paste
Range("E5").Select
Selection.Cut
Range("M2").Select
ActiveSheet.Paste
Range("D9").Select
Selection.Cut
Range("N2").Select
ActiveSheet.Paste
Range("E9").Select
Selection.Cut
Range("O2").Select
ActiveSheet.Paste
Range("P5").Select
Selection.Cut
Range("P2").Select
ActiveSheet.Paste
Range("L5").Select
Selection.Cut
Range("Q2").Select
ActiveSheet.Paste
Range("P9").Select
Selection.Cut
Range("R2").Select
ActiveSheet.Paste
Range("L9").Select
Selection.Cut
Range("S2").Select
ActiveSheet.Paste
Range("F5").Select
Selection.Cut
Range("T2").Select
ActiveSheet.Paste
Range("M5").Select
Selection.Cut
Range("U2").Select
ActiveSheet.Paste
Range("M9").Select
Selection.Cut
Range("V2").Select
ActiveSheet.Paste
Range("F9").Select
Selection.Cut
Range("W2").Select
ActiveSheet.Paste
Range("H5").Select
Selection.Cut
Range("X2").Select
ActiveSheet.Paste
Range("H9").Select
Selection.Cut
Range("Y2").Select
ActiveSheet.Paste
Range("N9").Select
Selection.Cut
Range("O5").Select
ActiveSheet.Paste
Range("N5:O5").Select
Range("O5").Activate
Selection.Cut
Range("Z2").Select
ActiveSheet.Paste
Range("k1").Select
Selection.Copy
Range("k2").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Copy
Rows("2:2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Rows("3:12").Select
Selection.Delete Shift:=xlUp
Rows("2:2").Select
Selection.Cut
End Sub

I do this every day and on some days there can be a many as 300 lines of data to copy
and it takes a lot of time.

The issue at the moment is I keep getting a Complile Error: Invalid use or property

Heres the code I found that I was hoping would speed it up, if I can utilise this and make it repeat until theres no data left to sort it would be a massive help

Sub Macro()
'
' Macro
'

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

'Set variables for copy and destination sheets
Set wsCopy = Workbooks("SDLsortCONFOR_Backup.xlsm").Worksheets("NEWSORT")
Set wsDest = Workbooks("SDLsortCONFOR_Backup.xlsm").Worksheets("Formatting")

'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

'3. Copy & Paste Data
wsCopy.Range("A2:A" & lCopyLastRow).Copy
wsDest.Range ("A" & lDestLastRow)


End Sub



Im getting the error highlighting the .Range part of wsDest.Range at the end of the code.

Im trying to learnt but this is messing with my head, Im guessing this is childsplay level stuff

Im using Excel 2019

Many thanks
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
These two lines of code:
VBA Code: 
wsCopy.Range("A2:A" & lCopyLastRow).Copy
wsDest.Range ("A" & lDestLastRow)
are supposed to be written, like this (on a sigle line):
Code: 
wsCopy.Range("A2:A" & lCopyLastRow).Copy wsDest.Range ("A" & lDestLastRow)
 
Upvote 0
It was something from the childsplay locker :rolleyes:

Cant get it working still tough although it does something now, thank you,
ill keep going with it now im past that stumbling block
rollis13 said:
These two lines of code:
VBA Code: 
wsCopy.Range("A2:A" & lCopyLastRow).Copy
wsDest.Range ("A" & lDestLastRow)
are supposed to be written, like this (on a sigle line):
Code: 
wsCopy.Range("A2:A" & lCopyLastRow).Copy wsDest.Range ("A" & lDestLastRow)[/COD
[/QUOTE]
Click to expand...
 
Upvote 0
All I can now suggest is to do some debugging. Manually launch your macro with F8 from vbe panel and then keep going on stepping through it with F8. Meanwhile, check the contents of the variables and see if their momentary value is compatible with what your macro should be doing. You can activate Locals variable panel to monitor. LINK Also using Immediate panel could be very helpful.
 
Upvote 0
Im pretty certain this macro is no good for what I need.
I need to run a macro I recorded which cuts and pastes 2 rows of data into a single row, deletes the 2 source rows so the next line of data is ready and then copy the single row into another worksheet and repeat until all the source data has beeen used.
When I run my macro to sort the first single row of data and then run this Copy and paste macro, It copies my first row that I sorted and then every row in its origonal format. Thats no good.
Thanks for your help
 
Upvote 0
So I went a different way when I found something that might work.
It does work but oh my god its so slow. I still cant get over how long a simple cut and paste can take in a macro.

Dont know if any of this code is slowing me down and not needed but it works.
I can only run this in bite sizes, have been doing 20 rows of data output before copy and pasting the 20 lines to another wookbook but before this code I was doing 1 line of data at a time.

Heres the code I managed to get working, any advice on tidying this up would be cool, I did leave all the unsused code from the vba I have used intact, just in case and my Macro is titled oakland jim because thats who's code I adapted, though I'd best give him some credit lol, thanks Jim

VBA Code: 
Sub oakland_jim()



'   Count of occupied rows in target worksheet (named "Formatting")
    Dim iRowsCount As Long
    
'   Count occupied rows in column A of worksheet named In Transit.
'   Need to place cut values into the next available (empty) row.
    iRowsCount = Worksheets("Formatting").Cells(100000, 1).End(xlUp).Row
    
    Range("A3:C3").Select
    Selection.Cut
    Range("A2").Select
    ActiveSheet.Paste
    Range("C4").Select
    Selection.Cut
    Range("F2").Select
    ActiveSheet.Paste
    Range("D3").Select
    Selection.Cut
    Range("G2").Select
    ActiveSheet.Paste
    Range("E3:H3").Select
    Selection.Cut
    Range("K2").Select
    ActiveSheet.Paste
    Range("I3").Select
    Selection.Cut
    Range("S2").Select
    ActiveSheet.Paste
    Range("J3:M3").Select
    Selection.Cut
    Range("W2").Select
    ActiveSheet.Paste
    Range("N3").Select
    Selection.Cut
    Range("P2").Select
    ActiveSheet.Paste
    Range("O3").Select
    Selection.Cut
    Range("R2").Select
    ActiveSheet.Paste
    Range("T3").Select
    Selection.Cut
    Range("H2").Select
    ActiveSheet.Paste
    Range("V3").Select
    Selection.Cut
    Range("I2").Select
    ActiveSheet.Paste
    Range("Z3").Select
    Selection.Cut
    Range("O2").Select
    ActiveSheet.Paste
    Range("AA3").Select
    Selection.Copy
    Range("Q2").Select
    ActiveSheet.Paste
    Range("J1").Select
    Selection.Copy
    Range("J2").Select
    ActiveSheet.Paste
    Range("W3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("T2").Select
    ActiveSheet.Paste
    Range("Y3").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("U2").Select
    ActiveSheet.Paste
    Rows("3:4").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Selection.Copy
    Rows("2:2").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut
    
    Application.ScreenUpdating = False
    
    If ActiveCell.Value Like "Data*" _
     Then
        MsgBox "Cannot move header cells! " & ActiveCell.Address & " was selected."
        Exit Sub
    End If
    
    If ActiveCell.Value = "" _
     Then
        MsgBox "There is nothing in cell " & ActiveCell.Address
        Exit Sub
    End If
    
'   Cut the row in source worksheet (NEWSORT) and paste into "next" empty
'   cell in column A in target worksheet (named "Formatting").
    ActiveCell.EntireRow.Cut Worksheets("Formatting").Cells(1, 1).Offset(iRowsCount)
    
    With Worksheets("Formatting").Range("A1").Offset(iRowsCount)

'       Delete cell in column 15 in newly pasted data row.
    '   .Cells(1, 15).Delete Shift:=xlToLeft

'       Delete cell in column 5 in newly pasted data row.
     '  .Cells(1, 5).Delete Shift:=xlToLeft

    End With
    
   ' Worksheets("NEWSORT").Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub



Sub LOOP_COUNT()

Dim runmacro
runmacro = Application.InputBox("How many times would you like this macro to run?", "Enter a number", , , , , , 1)

If IsNumeric(numrow) Then

For i = 1 To runmacro

Call oakland_jim

Next i
End If

End Sub
 
Upvote 0
I have no idea on how your sheet data is structured but have a try with this cut down version of your macro.
There is no need to use .Select then .Selection on separated lines, it only wastes time.
Then you should use function Application.ScreenUpdating to avoid even more waste of time so I added these in your macro LOOP_COUNT.
Hope I didn't mess up your Copy/Cut/Paste ranges while cutting down, please check.
VBA Code: 
Option Explicit
Sub oakland_jim()
    '   Count of occupied rows in target worksheet (named "Formatting")
    Dim iRowsCount As Long
    '   Count occupied rows in column A of worksheet named In Transit.
    '   Need to place cut values into the next available (empty) row.
    iRowsCount = Worksheets("Formatting").Cells(Rows.Count, 1).End(xlUp).Row
    Range("A3:C3").Cut Range("A2")
    Range("C4").Cut Range("F2")
    Range("D3").Cut Range("G2")
    Range("E3:H3").Cut Range("K2")
    Range("I3").Cut Range("S2")
    Range("J3:M3").Cut Range("W2")
    Range("N3").Cut Range("P2")
    Range("O3").Cut Range("R2")
    Range("T3").Cut Range("H2")
    Range("V3").Cut Range("I2")
    Range("Z3").Cut Range("O2")
    Range("AA3").Copy Range("Q2")
    Range("J1").Copy Range("J2")
    Range("W3").Copy Range("T2")
    Range("Y3").Cut Range("U2")
    Rows("3:4").Delete Shift:=xlUp
    Rows("1:1").Copy
    Rows("2:2").PasteSpecial Paste:=xlPasteFormats
    If ActiveCell.Value Like "Data*" Then
        MsgBox "Cannot move header cells! " & ActiveCell.Address & " was selected."
        Exit Sub
    End If
    If ActiveCell.Value = "" Then
        MsgBox "There is nothing in cell " & ActiveCell.Address
        Exit Sub
    End If
    '   Cut the row in source worksheet (NEWSORT) and paste into "next" empty
    '   cell in column A in target worksheet (named "Formatting").
    ActiveCell.EntireRow.Cut Worksheets("Formatting").Cells(1, 1).Offset(iRowsCount)
    With Worksheets("Formatting").Range("A1").Offset(iRowsCount)
        '   Delete cell in column 15 in newly pasted data row.
        '   .Cells(1, 15).Delete Shift:=xlToLeft
        '   Delete cell in column 5 in newly pasted data row.
        '  .Cells(1, 5).Delete Shift:=xlToLeft
    End With
    '   Worksheets("NEWSORT").Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Sub LOOP_COUNT()
    Dim runmacro, numrow, i
    runmacro = Application.InputBox("How many times would you like this macro to run?", "Enter a number", , , , , , 1)
    Application.ScreenUpdating = False            '<- added
    If IsNumeric(numrow) Then
        For i = 1 To runmacro
            Call oakland_jim
        Next i
    End If
    Application.ScreenUpdating = True             '<- added
End Sub
 
Upvote 0
Solution
Awwwwwww mate thats awesome, thank you
Im not going to try it now and pretty tired so Ill give it a go tomorrow and let you know :biggrin:
 
Upvote 0
rollis13 said:
I have no idea on how your sheet data is structured but have a try with this cut down version of your macro.
There is no need to use .Select then .Selection on separated lines, it only wastes time.
Then you should use function Application.ScreenUpdating to avoid even more waste of time so I added these in your macro LOOP_COUNT.
Hope I didn't mess up your Copy/Cut/Paste ranges while cutting down, please check.
VBA Code: 
Option Explicit
Sub oakland_jim()
    '   Count of occupied rows in target worksheet (named "Formatting")
    Dim iRowsCount As Long
    '   Count occupied rows in column A of worksheet named In Transit.
    '   Need to place cut values into the next available (empty) row.
    iRowsCount = Worksheets("Formatting").Cells(Rows.Count, 1).End(xlUp).Row
    Range("A3:C3").Cut Range("A2")
    Range("C4").Cut Range("F2")
    Range("D3").Cut Range("G2")
    Range("E3:H3").Cut Range("K2")
    Range("I3").Cut Range("S2")
    Range("J3:M3").Cut Range("W2")
    Range("N3").Cut Range("P2")
    Range("O3").Cut Range("R2")
    Range("T3").Cut Range("H2")
    Range("V3").Cut Range("I2")
    Range("Z3").Cut Range("O2")
    Range("AA3").Copy Range("Q2")
    Range("J1").Copy Range("J2")
    Range("W3").Copy Range("T2")
    Range("Y3").Cut Range("U2")
    Rows("3:4").Delete Shift:=xlUp
    Rows("1:1").Copy
    Rows("2:2").PasteSpecial Paste:=xlPasteFormats
    If ActiveCell.Value Like "Data*" Then
        MsgBox "Cannot move header cells! " & ActiveCell.Address & " was selected."
        Exit Sub
    End If
    If ActiveCell.Value = "" Then
        MsgBox "There is nothing in cell " & ActiveCell.Address
        Exit Sub
    End If
    '   Cut the row in source worksheet (NEWSORT) and paste into "next" empty
    '   cell in column A in target worksheet (named "Formatting").
    ActiveCell.EntireRow.Cut Worksheets("Formatting").Cells(1, 1).Offset(iRowsCount)
    With Worksheets("Formatting").Range("A1").Offset(iRowsCount)
        '   Delete cell in column 15 in newly pasted data row.
        '   .Cells(1, 15).Delete Shift:=xlToLeft
        '   Delete cell in column 5 in newly pasted data row.
        '  .Cells(1, 5).Delete Shift:=xlToLeft
    End With
    '   Worksheets("NEWSORT").Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Sub LOOP_COUNT()
    Dim runmacro, numrow, i
    runmacro = Application.InputBox("How many times would you like this macro to run?", "Enter a number", , , , , , 1)
    Application.ScreenUpdating = False            '<- added
    If IsNumeric(numrow) Then
        For i = 1 To runmacro
            Call oakland_jim
        Next i
    End If
    Application.ScreenUpdating = True             '<- added
End Sub
Click to expand...

Thank you soooooo much, this works absolutely perfect, even the cut/copy/paste ranges are spot on.
I wasnt even planning on trying to do this when I started but now it is done it will save me a lot of time, I cannot thank you enough
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
ActiveSheet. Paste error
Replies
1
Views
41
RoryA
RoryA
J
  • Question
Crashing Macro
2
Replies
12
Views
506
kevin9999
K
G
  • Question
Macro to cut entire row form table depending on the value of column "M" and paste on another table
Replies
3
Views
307
kevin9999
K
P
  • Question
Help with Vba Code
Replies
3
Views
164
Coyotex3
C
L
  • Solved
Copy and Pasting Loop
2
Replies
14
Views
722
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,069
Messages
6,122,958
Members
449,096
Latest member
Anshu121

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top