Copy error - range is cutting and pasting to wrong sheet

[rossross]

My code below:

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

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

 

[Alex Blakenburg]

Sorry I forgot to come back to this.
You are now appending data and you are only doing 1 column at a time.
Since the ranges on both sides of the equal sign need to be the same size there are 2 ways of doing it.
1) calculate the destination end row and end column required OR
2) resize the destination to the number of rows and columns being copied.
No 2 is generally easier unless you are copying to exactly the same place in both worksheets
Since you are now "appending" data, this is no longer the case.

So using resize, we know it is only 1 column so we just need to resize the number of rows.
So we are starting the copy at
(assuming lRow is the next empty cell in wr)

wr.Cells(lRow, col)

and we want to resize this to the number of rows being copied which we can calculate as:
lra - 2 + 1 being last row in ah MINUS first data row in ah ADD 1 because it is inclusive of first and last column.

End result was:

wr.Cells(lrw, col).Resize(lra - 1).Value = ah.Range(ah.Cells(2, itm), ah.Cells(lra, itm)).Value

Hope this hasn't just confused you further.