Copy Specific Cells and Paste on another sheet

Question

A while back I received help from the member simoco on my question Copy Range and Paste Values in another Sheet's specific Range and the copy paste script works wonderful but now I'm in need something a bit different.

I need to copy specific cells from one sheet and paste it on a specific range on another sheet in order to build a "DB".

This means whenever I run the script, it needs to copy the values to the next empty row.

I tried to modify the code mentioned on the other question, by changing the arrays from a Range to a Cell number but it does not work.

I tried this.

Sub Get_Data()
Dim lastrowDB As Long, lastrow As Long
Dim arr1, arr2, i As Integer

With Sheets("DB")
    lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

arr1 = Array("A3", "A4", "A6", "B14")
arr2 = Array("A", "B", "D", "E")

For i = LBound(arr1) To UBound(arr1)
    With Sheets("Sheet1")
         lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
         .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
         Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
    End With
Next
Application.CutCopyMode = False
End Sub

The debug points to

lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)

I'm not sure how to modify it to make it work as intended.

Thanks in advance for your assistance.

Run-Time Error '1004': Application-Defined or Object-Defined error — BlueSun3k1, Jun 01 '14 at 17:00
I suspect is because previously I copied entire rows from one sheet to another but now I'm copying specific cells. — BlueSun3k1, Jun 01 '14 at 17:02
Are cells A3, A4, A6 and B14 on `Sheet1` **ALWAYS** populated with the data you'd like to move to the `DB` sheet? — Dan Wagner, Jun 01 '14 at 17:20
Yes. I only intend to run the script once all the cells have the required data in them. — BlueSun3k1, Jun 01 '14 at 17:24
Use [THIS METHOD](http://www.siddharthrout.com/2012/10/02/find-last-row-in-an-excel-sheetvbavb-net/) to get the last row. — David Zemens, Jun 01 '14 at 18:26
Thank you David Zemens. I went over your suggestions and spent the last hour trying to work with it but no luck so far. The thing is that I don't need to find the last row in sheet1 because all the cells I need to copy are individual cells and not rows and so far the script is able to find the last row in the DB sheet as needed. I'm still lost. — BlueSun3k1, Jun 01 '14 at 20:42
Since arr1(i) starts off as "A3", then `.Cells(.Rows.Count, arr1(i))` starts off as `.Cells(.Rows.Count, "A3")` which can't be right. — dcromley, Jun 01 '14 at 21:36

score 1 · Accepted Answer · answered Jun 02 '14 at 10:55

The script below iterates through a SourceArr array containing your source cell addresses and pastes the values to destination columns as specified in the DestArr array:

Option Explicit
Sub MoveDataToDB()

Dim DB As Worksheet, SH As Worksheet
Dim TargetRow As Long, Index As Long
Dim SourceArr As Variant, DestArr As Variant
Dim Source As Range, Dest As Range

'set references up-front
Set SH = ThisWorkbook.Worksheets("Sheet1")
Set DB = ThisWorkbook.Worksheets("DB")
With DB
    TargetRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
SourceArr = Array("A3", "A4", "A6", "B14")
DestArr = Array("A", "B", "D", "E")

'loop through the source array, copying cell values to DB sheet
For Index = LBound(SourceArr) To UBound(SourceArr)
    Set Source = SH.Range(SourceArr(Index))
    Set Dest = DB.Range(DestArr(Index) & TargetRow)
    Source.Copy
    Dest.PasteSpecial (xlPasteValues)
Next Index

End Sub

One possible improvement to implement down the line would be an IsEmpty check on the Source range, to make sure the right cells have been populated.

Copy Specific Cells and Paste on another sheet

1 Answers1