Copy error - range is cutting and pasting to wrong sheet

rossross

New Member
Joined
Apr 11, 2022
Messages
39
Office Version
  1. 365
Platform
  1. Windows
My code below:

VBA Code:
Sub arrange()

'all declarations for wkshts and wbs stated at top unless stated here

Dim g1 As Range
Dim g2 As Range
Dim g3 As Range
Dim g4 As Range
Dim g5 As Range
Dim g6 As Range
Dim g7 As Range
Dim g8 As Range
Dim g9 As Range
Dim g10 As Range
Dim g11 As Range
Dim g12 As Range

Dim a1 As Range
Dim a2 As Range
Dim a3 As Range
Dim a4 As Range
Dim a5 As Range
Dim a6 As Range
Dim a7 As Range
Dim a8 As Range
Dim a9 As Range
Dim a10 As Range
Dim a11 As Range
Dim a12 As Range

Dim i As Integer

Set wb = ThisWorkbook
Set gr = wb.Worksheets("GR")
Set ah = wb.Worksheets("AH")
Set fls = wb.Worksheets("Fields")
Set wr = wb.Worksheets("Wrap")

Application.ScreenUpdating = False

With gr
    lrg = .Range("A1").End(xlDown).Row
    Set g1 = .Range("A2:A" & lrg)
    Set g2 = .Range("V2:V" & lrg)
    Set g3 = .Range("Y2:Y" & lrg)
    Set g4 = .Range("L2:L" & lrg)
    Set g5 = .Range("P2:P" & lrg)
    Set g6 = .Range("T2:T" & lrg)
    Set g7 = .Range("Z2:Z" & lrg)
    Set g8 = .Range("C2:C" & lrg)
    Set g9 = .Range("D2:D" & lrg)
    Set g10 = .Range("AB2:AB" & lrg)
    Set g11 = .Range("E2:E" & lrg)
    Set g12 = .Range("AI2:AI" & lrg)
End With

With ah
    lra = ah.Range("A1").End(xlDown).Row
    Set a1 = .Range("A2:A" & lra)
    Set a2 = .Range("H2:H" & lra)
    Set a3 = .Range("I2:I" & lra)
    Set a4 = .Range("AC2:AC" & lra)
    Set a5 = .Range("AA2:AA" & lra)
    Set a6 = .Range("Z2:Z" & lra)
    Set a7 = .Range("AO2:AO" & lra)
    Set a8 = .Range("D2:D" & lra)
    Set a9 = .Range("C2:C" & lra)
    Set a10 = .Range("G2:G" & lra)
    Set a11 = .Range("F2:F" & lra)
    Set a12 = .Range("AQ2:AQ" & lra)
End With

g1.Copy
wr.Range("A2").PasteSpecial Paste:=xlPasteValues
g2.Copy
wr.Range("B2").PasteSpecial Paste:=xlPasteValues
g3.Copy
wr.Range("C2").PasteSpecial Paste:=xlPasteValues
g4.Copy
wr.Range("D2").PasteSpecial Paste:=xlPasteValues
g5.Copy
wr.Range("E2").PasteSpecial Paste:=xlPasteValues
g6.Copy
wr.Range("F2").PasteSpecial Paste:=xlPasteValues
g7.Copy
wr.Range("G2").PasteSpecial Paste:=xlPasteValues
g8.Copy
wr.Range("H2").PasteSpecial Paste:=xlPasteValues
g9.Copy
wr.Range("I2").PasteSpecial Paste:=xlPasteValues
g10.Copy
wr.Range("J2").PasteSpecial Paste:=xlPasteValues
g11.Copy
wr.Range("K2").PasteSpecial Paste:=xlPasteValues
g12.Copy
wr.Range("L2").PasteSpecial Paste:=xlPasteValues

With wr
    lrw = .Range("A1").End(xlDown).Row
    i = 2
    Do Until i = lrw + 1
        Cells(i, 13).Value2 = "GR"
        i = i + 1
    Loop
   
    lrw = .Range("A1").End(xlDown).Row
    i = lrw + 1
End With
   
a1.Copy
wr.Cells(lrw + 1, "A").PasteSpecial Paste:=xlPasteValues
a2.Copy
wr.Cells(lrw + 1, "B").PasteSpecial Paste:=xlPasteValues
a3.Copy
wr.Cells(lrw + 1, "C").PasteSpecial Paste:=xlPasteValues
a4.Copy
wr.Cells(lrw + 1, "D").PasteSpecial Paste:=xlPasteValues
a5.Copy
wr.Cells(lrw + 1, "E").PasteSpecial Paste:=xlPasteValues
a6.Copy
wr.Cells(lrw + 1, "F").PasteSpecial Paste:=xlPasteValues
a7.Copy
wr.Cells(lrw + 1, "G").PasteSpecial Paste:=xlPasteValues
a8.Copy
wr.Cells(lrw + 1, "H").PasteSpecial Paste:=xlPasteValues
a9.Copy
wr.Cells(lrw + 1, "I").PasteSpecial Paste:=xlPasteValues
a10.Copy
wr.Cells(lrw + 1, "J").PasteSpecial Paste:=xlPasteValues
a11.Copy
wr.Cells(lrw + 1, "K").PasteSpecial Paste:=xlPasteValues
a12.Copy
wr.Cells(lrw + 1, "L").PasteSpecial Paste:=xlPasteValues

With wr
    lrw = .Range("A1").End(xlDown).Row
    Do Until i = lrw + 1
        Cells(i, 13).Value2 = "AH"
        i = i + 1
    Loop
End With
   
Application.CutCopyMode = False

Call formats

If fls.Range("B10").Value2 = "N" Then
    Call sendtodb
Else
    Call eject
End If


Application.ScreenUpdating = True

End Sub

The three codes below are the ones being called into the routine

VBA Code:
Sub formats()

Set wb = ThisWorkbook
Set wr = wb.Worksheets("Wrap")

With wr
    lrw = .Range("A1").End(xlDown).Row
    .Range("B2:C" & lrw).NumberFormat = "#,##0"
    .Range("D2:E" & lrw).NumberFormat = "#.00"
    .Range("F2" & lrw).NumberFormat = "#"
    .Range("N" & lrw).NumberFormat = "mm/dd/yy;@"
    .Range("G2:N" & lrw).HorizontalAlignment = xlCenter
End With
   
End Sub

Sub sendtodb()

Dim nwb As Workbook
Dim dt As Worksheet
Dim lrd As Long


Set wb = ThisWorkbook
Set fls = wb.Worksheets("Fields")
Set nwb = Workbooks.Open(Filename:=fls.Range("A23").Value2 & ".xlsx")
Set wr = wb.Worksheets("Wrap")
Set dt = nwb.Worksheets("Data")

With wr
    lrw = .Range("A1").End(xlDown).Row
End With

wr.Range("A2:N" & lrw).Copy
dt.Range("A2").PasteSpecial Paste:=xlPasteAll

With dt
    lrd = .Range("A1").End(xlDown).Row
    .Range("O2:Q2").Copy
    .Range("O3:Q" & lrd).PasteSpecial Paste:=xlPasteAll
    .Activate
End With

Application.CutCopyMode = False

End Sub

Sub eject()

Dim wb2 As Workbook
Dim ld As Worksheet
Dim lrl As Long

Set wb = ThisWorkbook
Set wr = wb.Worksheets("Wrap")
Set wb2 = Workbooks.Open('....file path
Set ld = wb2.Worksheets("Load")

With wr
    lrw = .Range("A1").End(xlDown).Row
End With

wr.Range("A2:N" & lrw).Copy
ld.Range("A2").PasteSpecial Paste:=xlPasteAll

With ld
    lrl = .Range("A1").End(xlDown).Row
    .Range("O2").Copy
    .Range("O3:O" & lrl).PasteSpecial Paste:=xlPasteAll
    .Activate
End With

End Sub


Whenever I do i break and step through the code, i have no issues. though, it does say "can't execute in break mode" but i click out of that and it steps right through.

What's happening is my range ("M2" & lrw) is for some reason cutting from the wr wksht and pasting to my fls wksht. the error occurs for both wkbk open operations.

Any thoughts as to what's causing this?

Also if anyone wants to take a stab at condensing this, i'm all ears.

thanks
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
What's happening is my range ("M2" & lrw) is for some reason cutting from the wr wksht and pasting to my fls wksht.

I do not see any code where the "Cut" is happening? I can see lot of "Copying" though.

As far as making your code concise is concerned, it can defnitely be made much smaller. There are lot of ways to achieve this. The idea is to look for pattern or try and create some sort of a loop.

Also one basic explanation. This code

VBA Code:
RngA.Copy
RngB.PasteSpecial Paste:=xlPasteValues

can also be written as

VBA Code:
RngB.Value = RngA.Value

We will use the above logic to get our values across in the code below. Also you have some fixed columns which you are copying from the GR worksheet. Why not store the column numbers in an array and then loop though the array. Here is an example

Your this code

VBA Code:
With gr
    lrg = .Range("A1").End(xlDown).Row
    Set g1 = .Range("A2:A" & lrg)
    Set g2 = .Range("V2:V" & lrg)
    Set g3 = .Range("Y2:Y" & lrg)
    Set g4 = .Range("L2:L" & lrg)
    Set g5 = .Range("P2:P" & lrg)
    Set g6 = .Range("T2:T" & lrg)
    Set g7 = .Range("Z2:Z" & lrg)
    Set g8 = .Range("C2:C" & lrg)
    Set g9 = .Range("D2:D" & lrg)
    Set g10 = .Range("AB2:AB" & lrg)
    Set g11 = .Range("E2:E" & lrg)
    Set g12 = .Range("AI2:AI" & lrg)
End With

g1.Copy
wr.Range("A2").PasteSpecial Paste:=xlPasteValues
g2.Copy
wr.Range("B2").PasteSpecial Paste:=xlPasteValues
g3.Copy
wr.Range("C2").PasteSpecial Paste:=xlPasteValues
g4.Copy
wr.Range("D2").PasteSpecial Paste:=xlPasteValues
g5.Copy
wr.Range("E2").PasteSpecial Paste:=xlPasteValues
g6.Copy
wr.Range("F2").PasteSpecial Paste:=xlPasteValues
g7.Copy
wr.Range("G2").PasteSpecial Paste:=xlPasteValues
g8.Copy
wr.Range("H2").PasteSpecial Paste:=xlPasteValues
g9.Copy
wr.Range("I2").PasteSpecial Paste:=xlPasteValues
g10.Copy
wr.Range("J2").PasteSpecial Paste:=xlPasteValues
g11.Copy
wr.Range("K2").PasteSpecial Paste:=xlPasteValues
g12.Copy
wr.Range("L2").PasteSpecial Paste:=xlPasteValues

With wr
    lrw = .Range("A1").End(xlDown).Row
    i = 2
    Do Until i = lrw + 1
        Cells(i, 13).Value2 = "GR"
        i = i + 1
    Loop
 
    lrw = .Range("A1").End(xlDown).Row
    i = lrw + 1
End With

can also be written as (UNTESTED)

VBA Code:
    Dim ar, itm
    Dim lRow As Long
    Dim col As Long: col = 1
 
    '~~> 1 is Col A, 3 is Col C and so on till 28 which is Col AB
    '~~> These are the cols that you are copying from GR to WRAP
    ar = Array(1, 3, 4, 5, 12, 16, 20, 22, 25, 26, 28)
    lRow = gr.Range("A" & gr.Rows.Count).End(xlUp).Row
 
    For Each itm In ar
        wr.Range(wr.Cells(2, col), wr.Cells(lRow, col)).Value = gr.Range(gr.Cells(2, itm), gr.Cells(lRow, itm)).Value
        col = col + 1
    Next itm
 
    lRow = wr.Range("A" & wr.Rows.Count).End(xlUp).Row
    wr.Range("M2:M" & lRow).Value = "GR"

Similarly for others.
 
Last edited:
Upvote 0
Exactly - it’s not supposed to be cutting anything. That’s the issue. That whole range is supposed to go to either of those other workbooks. Instead, it’s copying and moving all of it but that one column and that one column is for some reason being cut and placed on another worksheet. Not supposed to happen.


Cant wait to try the rest of your message though. Will update asap. Thanks
 
Upvote 0
If you switch to @Siddharth Rout's version this will no longer be an issue but in 2 places you have something that looks like the code snippet below.
Although it is inside a with statement there is no Full Stop (.) before the Cells object which means it is using the ActiveSheet when it runs.
This would be why you are getting inconsistent results and since column 13 is column M is most likely the sort of your Column M issue.

Rich (BB code):
With wr
    lrw = .Range("A1").End(xlDown).Row
    i = 2
    Do Until i = lrw + 1
        Cells(i, 13).Value2 = "GR"
 
Upvote 0
If you switch to @Siddharth Rout's version this will no longer be an issue but in 2 places you have something that looks like the code snippet below.
Although it is inside a with statement there is no Full Stop (.) before the Cells object which means it is using the ActiveSheet when it runs.
This would be why you are getting inconsistent results and since column 13 is column M is most likely the sort of your Column M issue.

Rich (BB code):
With wr
    lrw = .Range("A1").End(xlDown).Row
    i = 2
    Do Until i = lrw + 1
        Cells(i, 13).Value2 = "GR"
this does solve it. crazy how one little thing makes that big of a difference. thanks
 
Upvote 0
Yes that tiny little period symbol does have quite an impact. Even more easily missed when it is burried a bit further into line of code between some parenthesis ;)
Glad we could help.
 
Upvote 0
I do not see any code where the "Cut" is happening? I can see lot of "Copying" though.

As far as making your code concise is concerned, it can defnitely be made much smaller. There are lot of ways to achieve this. The idea is to look for pattern or try and create some sort of a loop.

Also one basic explanation. This code

VBA Code:
RngA.Copy
RngB.PasteSpecial Paste:=xlPasteValues

can also be written as

VBA Code:
RngB.Value = RngA.Value

We will use the above logic to get our values across in the code below. Also you have some fixed columns which you are copying from the GR worksheet. Why not store the column numbers in an array and then loop though the array. Here is an example

Your this code

VBA Code:
With gr
    lrg = .Range("A1").End(xlDown).Row
    Set g1 = .Range("A2:A" & lrg)
    Set g2 = .Range("V2:V" & lrg)
    Set g3 = .Range("Y2:Y" & lrg)
    Set g4 = .Range("L2:L" & lrg)
    Set g5 = .Range("P2:P" & lrg)
    Set g6 = .Range("T2:T" & lrg)
    Set g7 = .Range("Z2:Z" & lrg)
    Set g8 = .Range("C2:C" & lrg)
    Set g9 = .Range("D2:D" & lrg)
    Set g10 = .Range("AB2:AB" & lrg)
    Set g11 = .Range("E2:E" & lrg)
    Set g12 = .Range("AI2:AI" & lrg)
End With

g1.Copy
wr.Range("A2").PasteSpecial Paste:=xlPasteValues
g2.Copy
wr.Range("B2").PasteSpecial Paste:=xlPasteValues
g3.Copy
wr.Range("C2").PasteSpecial Paste:=xlPasteValues
g4.Copy
wr.Range("D2").PasteSpecial Paste:=xlPasteValues
g5.Copy
wr.Range("E2").PasteSpecial Paste:=xlPasteValues
g6.Copy
wr.Range("F2").PasteSpecial Paste:=xlPasteValues
g7.Copy
wr.Range("G2").PasteSpecial Paste:=xlPasteValues
g8.Copy
wr.Range("H2").PasteSpecial Paste:=xlPasteValues
g9.Copy
wr.Range("I2").PasteSpecial Paste:=xlPasteValues
g10.Copy
wr.Range("J2").PasteSpecial Paste:=xlPasteValues
g11.Copy
wr.Range("K2").PasteSpecial Paste:=xlPasteValues
g12.Copy
wr.Range("L2").PasteSpecial Paste:=xlPasteValues

With wr
    lrw = .Range("A1").End(xlDown).Row
    i = 2
    Do Until i = lrw + 1
        Cells(i, 13).Value2 = "GR"
        i = i + 1
    Loop
 
    lrw = .Range("A1").End(xlDown).Row
    i = lrw + 1
End With

can also be written as (UNTESTED)

VBA Code:
    Dim ar, itm
    Dim lRow As Long
    Dim col As Long: col = 1
 
    '~~> 1 is Col A, 3 is Col C and so on till 28 which is Col AB
    '~~> These are the cols that you are copying from GR to WRAP
    ar = Array(1, 3, 4, 5, 12, 16, 20, 22, 25, 26, 28)
    lRow = gr.Range("A" & gr.Rows.Count).End(xlUp).Row
 
    For Each itm In ar
        wr.Range(wr.Cells(2, col), wr.Cells(lRow, col)).Value = gr.Range(gr.Cells(2, itm), gr.Cells(lRow, itm)).Value
        col = col + 1
    Next itm
 
    lRow = wr.Range("A" & wr.Rows.Count).End(xlUp).Row
    wr.Range("M2:M" & lRow).Value = "GR"

Similarly for others.

using array is what i initially tried to do but couldn't get it to work for some reason. the logic is sound but i guess i couldn't get to the next step to execute it.

i'm getting "object doesn't support this property or method" error at this line

VBA Code:
wr.Range(wr.Cells(2, col), wr.Cells(lRow, col)).Value = gr.Range(gr.Cells(2, itm), gr.Cells(lRow, itm)).Value


edit: nevermind i typed it out again and it works i guess i had a typo somewhere. thank you so much this works. i just need to figure out how to get it in the right order.
 
Last edited:
Upvote 0
I do not see any code where the "Cut" is happening? I can see lot of "Copying" though.

As far as making your code concise is concerned, it can defnitely be made much smaller. There are lot of ways to achieve this. The idea is to look for pattern or try and create some sort of a loop.

Also one basic explanation. This code

VBA Code:
RngA.Copy
RngB.PasteSpecial Paste:=xlPasteValues

can also be written as

VBA Code:
RngB.Value = RngA.Value

We will use the above logic to get our values across in the code below. Also you have some fixed columns which you are copying from the GR worksheet. Why not store the column numbers in an array and then loop though the array. Here is an example

Your this code

VBA Code:
With gr
    lrg = .Range("A1").End(xlDown).Row
    Set g1 = .Range("A2:A" & lrg)
    Set g2 = .Range("V2:V" & lrg)
    Set g3 = .Range("Y2:Y" & lrg)
    Set g4 = .Range("L2:L" & lrg)
    Set g5 = .Range("P2:P" & lrg)
    Set g6 = .Range("T2:T" & lrg)
    Set g7 = .Range("Z2:Z" & lrg)
    Set g8 = .Range("C2:C" & lrg)
    Set g9 = .Range("D2:D" & lrg)
    Set g10 = .Range("AB2:AB" & lrg)
    Set g11 = .Range("E2:E" & lrg)
    Set g12 = .Range("AI2:AI" & lrg)
End With

g1.Copy
wr.Range("A2").PasteSpecial Paste:=xlPasteValues
g2.Copy
wr.Range("B2").PasteSpecial Paste:=xlPasteValues
g3.Copy
wr.Range("C2").PasteSpecial Paste:=xlPasteValues
g4.Copy
wr.Range("D2").PasteSpecial Paste:=xlPasteValues
g5.Copy
wr.Range("E2").PasteSpecial Paste:=xlPasteValues
g6.Copy
wr.Range("F2").PasteSpecial Paste:=xlPasteValues
g7.Copy
wr.Range("G2").PasteSpecial Paste:=xlPasteValues
g8.Copy
wr.Range("H2").PasteSpecial Paste:=xlPasteValues
g9.Copy
wr.Range("I2").PasteSpecial Paste:=xlPasteValues
g10.Copy
wr.Range("J2").PasteSpecial Paste:=xlPasteValues
g11.Copy
wr.Range("K2").PasteSpecial Paste:=xlPasteValues
g12.Copy
wr.Range("L2").PasteSpecial Paste:=xlPasteValues

With wr
    lrw = .Range("A1").End(xlDown).Row
    i = 2
    Do Until i = lrw + 1
        Cells(i, 13).Value2 = "GR"
        i = i + 1
    Loop
 
    lrw = .Range("A1").End(xlDown).Row
    i = lrw + 1
End With

can also be written as (UNTESTED)

VBA Code:
    Dim ar, itm
    Dim lRow As Long
    Dim col As Long: col = 1
 
    '~~> 1 is Col A, 3 is Col C and so on till 28 which is Col AB
    '~~> These are the cols that you are copying from GR to WRAP
    ar = Array(1, 3, 4, 5, 12, 16, 20, 22, 25, 26, 28)
    lRow = gr.Range("A" & gr.Rows.Count).End(xlUp).Row
 
    For Each itm In ar
        wr.Range(wr.Cells(2, col), wr.Cells(lRow, col)).Value = gr.Range(gr.Cells(2, itm), gr.Cells(lRow, itm)).Value
        col = col + 1
    Next itm
 
    lRow = wr.Range("A" & wr.Rows.Count).End(xlUp).Row
    wr.Range("M2:M" & lRow).Value = "GR"

Similarly for others.

i'm trying to add the other ws to the bottom of where this goes. what i added to what you already have

VBA Code:
dim ar2
'extra array
dim lra as long

lrw = wr.Range("A" & wr.Rows.Count).End(xlUp).Row
lrw = lrw + 1
col = 1
'these three lines to reset the location and create new landing area

ar2 = Array(1, 8, 9, 29, 27, 26, 41, 4, 3, 7, 6, 43)
lra = ah.Range("A" & ah.Rows.Count).End(xlUp).Row

for each itm in ar2
    wr.range(wr.cells(lrw,col), wr.cells(lra,col)).value2 = ah.range(ah.cells(lrw,otm)ah.cells(lra,itm)).value
    col = col +1 
next itm


i edited lrow from your original to lrw and lra and lrg for their respective pages i believe that shouldn't cause a bug.

the code does run and places things in order but at the wrong row. in my test data i'm using, ws gr has 2136 rows it's adding and the second page has 1371. running the code this way executes the first one that you prepared perfectly but then my addition adds only the first line of the second sheet to it and places it at row 1371. then everything below it is blank. any idea what could be causing that?
 
Upvote 0
Try changing your for loop to this:
VBA Code:
For Each itm In ar2
    wr.Cells(lrw, col).Resize(lra - 1).Value = ah.Range(ah.Cells(2, itm), ah.Cells(lra, itm)).Value
    col = col + 1
Next itm
 
Upvote 0
Try changing your for loop to this:
VBA Code:
For Each itm In ar2
    wr.Cells(lrw, col).Resize(lra - 1).Value = ah.Range(ah.Cells(2, itm), ah.Cells(lra, itm)).Value
    col = col + 1
Next itm

thank you this works perfectly. do you mind explaining why though? i can't wrap my head around it.
 
Upvote 0

Forum statistics

Threads
1,223,948
Messages
6,175,571
Members
452,652
Latest member
eduedu

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