Excel VBA for each cell in range A, copy value in cell B, to new sheet

Question

I have values in Sheet1 like: A1 = 23, B1 = M, C1 = 256 and for each value in range A, I need to copy value from cell B1 and C1 to Sheet2 into cell A6 and D7.

thank you very much for your help

Hello, yes. I tryed to make it like:

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

    With Sheets("Hárok2")
         lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    Sheets("Hárok1").Select
    arr1 = Array("B", "C", "D")
    Sheets("Hárok2").Select
    arr2 = Array("B3:C3", "B7:C7", "E7:F7")

    For i = LBound(arr1) To UBound(arr1)
        With Sheets("Hárok1")
             lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
             .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
             Sheets("Hárok2").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
        End With
        'Sheets("Hárok2").Select
        'Range("A1:L5").PrintOut  
    Next  
     Application.CutCopyMode = False
End Sub

but it give me a error in line: Sheets("Hárok2").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues

findwindow findwindow · Accepted Answer · 2015-09-10T19:35:18

Array is overkill here I think. I am guessing you want it to continue from A6 and D7 on down. Obviously change worksheets as necessary. This is pulling from ws1 (source) to ws2 (destination).

Sub denn()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long

Set ws1 = WorkSheets("Sheet4")
Set ws2 = WorkSheets("Sheet5")
lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
    ws2.Cells(i + 5, 1) = ws1.Cells(i, 2).Value
    ws2.Cells(i + 6, 4).Value = ws1.Cells(i, 3).Value
Next

End Sub

Excel VBA for each cell in range A, copy value in cell B, to new sheet

1 Answers