Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Increasing range for each iteration

Tags:

excel

vba

I'm automating an Excel sheet for my work and I'm stuck in a problem.

I'm trying to copy a specific range (A3:D3) and paste it to the ending row of another workbook. I'm trying to use an if statement to filter ranges that have the number 0 in cell B3.

Please help. I'm a complete rookie and I'm just starting out. Sorry if there's a lot of questions.

I've tried to change the range to a cell (i, 2) but it only copies B3 and not the rest (A3:D3).

Edit: forgot to add the s in cells Edit2: I just need to copy four cells (A3:D3) and increment it on my next iteration so that the copied cell would be (A4:D4)

Sub CopyData()

Dim wsCopy As Worksheet, wsDest As Worksheet
Dim iCopyLastRow As Long, iDestLastRow As Long

Set wsCopy = Workbooks("file1.xlsx").Worksheets("trend")
Set wsDest = Workbooks("file2.xlsx").Worksheets("raw data")

iCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

    For i = 3 To iCopyLastRow
        If wsCopy.Cells(i, 2).Value = 0 Then

        Else
        wsCopy.range(Cell(i,2), Cell(i,4)).Copy
        'wsCopy.Cells(i, 2). Copy ##this copies just one cell

        iDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
        wsDest.range("A" & iDestLastRow).PasteSpecial xlPasteValues
        End If

    Next i

Error messages:

Run-time error '1004':

Method 'Range' of object '_Worksheet' failed

and the debug highlights wsCopy.range(Cell(i,2), Cell(i,4)).Copy, the statement after else

like image 758
zen_4551 Avatar asked Jan 22 '26 18:01

zen_4551


1 Answers

Try using this code:

Sub CopyData()
    Dim wsCopy As Worksheet, wsDest As Worksheet
    Dim iCopyLastRow As Long, iDestLastRow As Long

    Set wsCopy = Workbooks("file1.xlsx").Worksheets("trend")
    Set wsDest = Workbooks("file2.xlsx").Worksheets("raw data")

    iCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

    For i = 3 To iCopyLastRow
        If wsCopy.Cells(i, 1).Value <> 0 Then
            'A = 1, D = 4
            wsCopy.Range(wsCopy.Cells(i, 1), wsCopy.Cells(i, 4)).Copy

            iDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row

            wsDest.Range("A" & iDestLastRow).PasteSpecial xlPasteValues
        End If
    Next i
End Sub

Just make sure that iCopyLastRow and iDestLastRow are the values that you expect.

I hope this helps.

like image 99
Louis Avatar answered Jan 24 '26 11:01

Louis