Excel vba - if something copy to one column, else copy to other

[beruf3]

I have a list of codes in "C" column of Sheet2, and
if the code begins with "xxx" I need to copy value from "D" column of Sheet2
to "A" column of Sheet1,
otherwise to "B" column of Sheet1.

Here's my code.
It's simple, but it works.

Set ws1 = Sheets("Sheet2")
Set ws2 = Sheets("Sheet1")

FinalRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row

For i = 1 To FinalRow
    If Left(ws1.Range("c" & i).Value, 3) = "xxx" Then
    k = k + 1
    ws2.Range("A" & k).Value = ws1.Range("D" & i).Value
    Else
    j = j + 1
    ws2.Range("B" & j).Value = ws1.Range("D" & i).Value
    End If
Next

Because I have large list of data, is it possible
to it more effectively.

 

[Akuini]

Try this:

Sub a1014583a()
'https://www.mrexcel.com/forum/excel-questions/1014583-excel-visual-basic-applications-if-something-copy-one-column-else-copy-other.html
Dim i As Long, j As Long, k As Long, finalrow As Long
Set ws1 = Sheets("Sheet2")
Set ws2 = Sheets("Sheet1")

finalrow = ws1.Cells(Rows.count, "C").End(xlUp).row
vc = ws1.Range(ws1.Cells(1, "C"), ws1.Cells(finalrow, "D"))
ReDim va(1 To UBound(vc, 1), 1 To 1)
ReDim vb(1 To UBound(vc, 1), 1 To 1)

For i = 1 To finalrow
    If Left(vc(i, 1), 3) = "xxx" Then
    k = k + 1
    va(k, 1) = vc(i, 2)
    Else
    j = j + 1
    vb(j, 1) = vc(i, 2)
    End If
Next

ws2.Range("A1").Resize(k, 1) = va
ws2.Range("B1").Resize(j, 1) = vb
End Sub

 

[beruf3]

Thanks, that worked 10 times faster.

 

[Akuini]

You're welcome & thanks for replying