Copy and pasting multiple cells

Question

I am trying to copy and paste several cells from one workbook into another. I am trying to get the source cells into one row and loop with other workbooks to copy and paste cells below the previous (hence lastrow statement).

The code I have does not seem to be working and is severely inefficient! As you will notice the cells are not in a neat range that can be easily copied.

See below:
    ...        
        lastrow2 = shtBatchwbkBGAsumm.Range("B65536").End(xlUp).Row + 1
        shtWBc2.Unprotect Password:="QC"

        shtWBc2.Range("C4").Value = shtBatchwbkBGAsumm.Range("B" & lastrow2).Value
        shtWBc2.Range("C5").Value = shtBatchwbkBGAsumm.Range("C" & lastrow2).Value
        shtWBc2.Range("D10").Value = shtBatchwbkBGAsumm.Range("D" & lastrow2).Value
        shtWBc2.Range("G10").Value = shtBatchwbkBGAsumm.Range("E" & lastrow2).Value
        shtWBc2.Range("J10").Value = shtBatchwbkBGAsumm.Range("F" & lastrow2).Value
        shtWBc2.Range("M10").Value = shtBatchwbkBGAsumm.Range("G" & lastrow2).Value
        shtWBc2.Range("P10").Value = shtBatchwbkBGAsumm.Range("H" & lastrow2).Value
        shtWBc2.Range("S10").Value = shtBatchwbkBGAsumm.Range("I" & lastrow2).Value
        shtWBc2.Range("C14").Value = shtBatchwbkBGAsumm.Range("J" & lastrow2).Value
        shtWBc2.Range("C15").Value = shtBatchwbkBGAsumm.Range("K" & lastrow2).Value
        shtWBc2.Range("D20").Value = shtBatchwbkBGAsumm.Range("L" & lastrow2).Value
        shtWBc2.Range("G20").Value = shtBatchwbkBGAsumm.Range("M" & lastrow2).Value
        shtWBc2.Range("J20").Value = shtBatchwbkBGAsumm.Range("N" & lastrow2).Value
        shtWBc2.Range("M20").Value = shtBatchwbkBGAsumm.Range("O" & lastrow2).Value
        shtWBc2.Range("P20").Value = shtBatchwbkBGAsumm.Range("P" & lastrow2).Value
        shtWBc2.Range("S20").Value = shtBatchwbkBGAsumm.Range("Q" & lastrow2).Value
        shtWBc2.Range("C24").Value = shtBatchwbkBGAsumm.Range("R" & lastrow2).Value
        shtWBc2.Range("C25").Value = shtBatchwbkBGAsumm.Range("S" & lastrow2).Value
        shtWBc2.Range("D30").Value = shtBatchwbkBGAsumm.Range("T" & lastrow2).Value
        shtWBc2.Range("G30").Value = shtBatchwbkBGAsumm.Range("U" & lastrow2).Value
        shtWBc2.Range("J30").Value = shtBatchwbkBGAsumm.Range("V" & lastrow2).Value
        shtWBc2.Range("M30").Value = shtBatchwbkBGAsumm.Range("W" & lastrow2).Value
        shtWBc2.Range("P30").Value = shtBatchwbkBGAsumm.Range("X" & lastrow2).Value
        shtWBc2.Range("S30").Value = shtBatchwbkBGAsumm.Range("Y" & lastrow2).Value
        shtWBc2.Range("C34").Value = shtBatchwbkBGAsumm.Range("Z" & lastrow2).Value
        shtWBc2.Range("C35").Value = shtBatchwbkBGAsumm.Range("AA" & lastrow2).Value
        shtWBc2.Range("D40").Value = shtBatchwbkBGAsumm.Range("AB" & lastrow2).Value
        shtWBc2.Range("G40").Value = shtBatchwbkBGAsumm.Range("AC" & lastrow2).Value
        shtWBc2.Range("J40").Value = shtBatchwbkBGAsumm.Range("AD" & lastrow2).Value
        shtWBc2.Range("M40").Value = shtBatchwbkBGAsumm.Range("AE" & lastrow2).Value
        shtWBc2.Range("P40").Value = shtBatchwbkBGAsumm.Range("AF" & lastrow2).Value
        shtWBc2.Range("S40").Value = shtBatchwbkBGAsumm.Range("AG" & lastrow2).Value
        shtWBc2.Range("C54").Value = shtBatchwbkBGAsumm.Range("AH" & lastrow2).Value
        shtWBc2.Range("C55").Value = shtBatchwbkBGAsumm.Range("AI" & lastrow2).Value
        shtWBc2.Range("D60").Value = shtBatchwbkBGAsumm.Range("AJ" & lastrow2).Value
        shtWBc2.Range("G60").Value = shtBatchwbkBGAsumm.Range("AK" & lastrow2).Value
        shtWBc2.Range("J60").Value = shtBatchwbkBGAsumm.Range("AL" & lastrow2).Value
        shtWBc2.Range("M60").Value = shtBatchwbkBGAsumm.Range("AM" & lastrow2).Value
        shtWBc2.Range("P60").Value = shtBatchwbkBGAsumm.Range("AN" & lastrow2).Value
        shtWBc2.Range("S60").Value = shtBatchwbkBGAsumm.Range("AO" & lastrow2).Value
        shtWBc2.Range("V56").Value = shtBatchwbkBGAsumm.Range("AP" & lastrow2).Value
        shtWBc2.Range("V57").Value = shtBatchwbkBGAsumm.Range("AQ" & lastrow2).Value
        shtWBc2.Range("W65").Value = shtBatchwbkBGAsumm.Range("AR" & lastrow2).Value
        shtWBc2.Range("C44").Value = shtBatchwbkBGAsumm.Range("AS" & lastrow2).Value
        shtWBc2.Range("C45").Value = shtBatchwbkBGAsumm.Range("AT" & lastrow2).Value
        shtWBc2.Range("D50").Value = shtBatchwbkBGAsumm.Range("AU" & lastrow2).Value
        shtWBc2.Range("G50").Value = shtBatchwbkBGAsumm.Range("AV" & lastrow2).Value
        shtWBc2.Range("J50").Value = shtBatchwbkBGAsumm.Range("AW" & lastrow2).Value
        shtWBc2.Range("M50").Value = shtBatchwbkBGAsumm.Range("AX" & lastrow2).Value
        shtWBc2.Range("P50").Value = shtBatchwbkBGAsumm.Range("AY" & lastrow2).Value
        shtWBc2.Range("S50").Value = shtBatchwbkBGAsumm.Range("AZ" & lastrow2).Value
        shtWBc2.Range("V46").Value = shtBatchwbkBGAsumm.Range("BA" & lastrow2).Value
        shtWBc2.Range("V47").Value = shtBatchwbkBGAsumm.Range("BB" & lastrow2).Value
        shtWBc2.Range("P65").Value = shtBatchwbkBGAsumm.Range("BC" & lastrow2).Value
        shtWBc2.Range("G65").Value = shtBatchwbkBGAsumm.Range("BD" & lastrow2).Value


        Application.CutCopyMode = False
        WBc.Close SaveChanges:=False

    End If
Next F........

At present, nothing is getting copied over and it takes a long while to get through four loops - I will be doing up to 40 loops.

Thanks in advance

Tim Williams · Accepted Answer

 lastrow2 = shtBatchwbkBGAsumm.Range("B65536").End(xlUp).Row + 1

This is giving you the row number for the first row with no content in ColB, not the last row with any content in ColB. Maybe you need to drop the + 1 ?

Edited to reverse direction of copy:

a) copying *from* shtBatchwbkBGAsumm 
b) copying *to* shtBatchwbkBGAsumm

Here's one alternative approach:

Dim arr, i As Long, rw As Range

'create an array of your "destination" ranges
arr = Array("C4", "C5", "G10", "J10", "M10", "P10") 'add the rest here...

'(a) assign the last row with data to the variable "rw"
'Set rw = shtBatchwbkBGAsumm.Range("B65536").End(xlUp).EntireRow

'(b) assign the first empty row to the variable "rw"
Set rw = shtBatchwbkBGAsumm.Range("B65536").End(xlUp).EntireRow.Offset(1,0)

shtWBc2.Unprotect Password:="QC"

'lbound here will be zero, ubound=(# of ranges-1)
For i = LBound(arr) To UBound(arr)

    'shtWBc2.Range(arr(i)).Value = rw.Cells(i + 2).Value 'direction (a)
    rw.Cells(i + 2).Value = shtWBc2.Range(arr(i)).Value 'direction (b)

Next i

Application.CutCopyMode = False
WBc.Close SaveChanges:=False

Here's I'm using rw to represent a range (row) on shtBatchwbkBGAsumm - makes for cleaner syntax.

E.g. compare:

rw.cells(,"B").Value

vs.

shtBatchwbkBGAsumm.Range("B" & lastrow2).Value

Copy and pasting multiple cells

Answers (1)

Related Questions