How do I copy a range of formula values and paste them to a specific range in another sheet?

You can change

Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)

to

Range("B3:B65536").Copy 
Sheets("DB").Range("B" & lastrow).PasteSpecial xlPasteValues

BTW, if you have xls file (excel 2003), you would get an error if your lastrow would be greater 3.

Try to use this code instead:

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("B", "C", "D", "E", "F", "AH", "AI", "AJ", "J", "P", "AF")
    arr2 = Array("B", "A", "C", "P", "D", "E", "G", "F", "H", "I", "J")

    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

Note, above code determines last non empty row on DB sheet in column A (variable lastrowDB). If you need to find lastrow for each destination column in DB sheet, use next modification:

For i = LBound(arr1) To UBound(arr1)
   With Sheets("DB")
       lastrowDB = .Cells(.Rows.Count, arr2(i)).End(xlUp).Row + 1
   End With

   ' NEXT CODE

Next

You could also use next approach instead Copy/PasteSpecial. Replace

.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues

with

Sheets("DB").Range(arr2(i) & lastrowDB).Resize(lastrow - 2).Value = _
      .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Value

Tags:

Excel

Vba

Recent Posts