CODEWITHSUNDEEP
vbaexcel
paulinhax
paulinhax

Reputation: 602

vba to copy to different ranges

I have this sheet called Consulta where everytime I change the value on the column K it changes the color of the range E:K to green or white if it's empty.

I also want to if the row is green, copy that row to the sheet called E-mail. This is what I've tried so far and it works:

Sub ChangeColor()
Dim ws As Worksheet, ws1 As Worksheet, i As Long, lastrow As Long

Set ws = Sheets("Consulta")
Set ws1 = Sheets("E-mail")

lastrow = ws.Cells(Rows.Count, "E").End(xlUp).Row


For i = 5 To lastrow
If ws.Range("K" & i) <> "" Then
    ws.Range("E" & i & ":K" & i).Interior.ColorIndex = 43
    ws.Range("E" & i & ":K" & i).Copy ws1.Range("A" & i & ":G" & i)
Else
    ws.Range("E" & i & ":K" & i).Interior.ColorIndex = 2
End If
Next

If ws.Range("E" & i & ":K" & i).Interior.ColorIndex = 2 Then
    ws1.Range("A" & i & ":G" & i).Clear
End If
End Sub

My problem is with this line below:

ws.Range("E" & i & ":K" & i).Copy ws1.Range("A" & i & ":G" & i)

I actually want to copy to a different range instead of the corresponding range in the sheet E-mail (for example, if the first match is E3:K3 I want to copy to A2:K2. If the second match is E34:K34 I want to copy it to A3:K3 and so it goes).

I tried using another loop but my Excel got crazy so I think I did it wrong.

Any suggestions will be appreciated.

Upvotes: 0

Views: 253

Answers (1)

user4039065
user4039065

Reputation:

You only need the upper-left corner cell for a destination. Look from the bottom up for the last used cell and offset down a row.

with ws1
    ws.Range("E" & i & ":K" & i).Copy .cells(.rows.count, "A").end(xlup).offset(1, 0)
end with

You might want to put this above the line that applies a fill color or you will be copying the fill color as well.

Upvotes: 3

Related Questions