Copy paste specific cells from a row based on cell value of column C

[est1989]

Hi Everyone,

I am new to the forum and I am great at Excel - whilst also being terrible at VBA! Which I guess in itself is an oxymoron.

I am really stuck.


I need to paste information from columns on one sheet to columns on another (not entire rows and in a different order). The source columns (to copy) for each row will depend on the value in column C, whilst the destination will be a fixed column on the new sheet.

Example of logic below:

For each row (of selection on Sheet1) IF column C reads "C" Then Copy Sheet1.D paste to Sheet2.D And Copy Sheet1.E paste to Sheet2.E and so on...

Then

For each row (of selection on Sheet1) IF column C reads "D" Then Copy Sheet1.F paste to Sheet2.D And Copy Sheet1.G paste to Sheet2.E and so on...

Repeat for entire selection on Sheet 1

Paste in destination starting from first blank row. I have left the row numbers out because these would change based on when the code encounters a specific value in column C on sheet 1 and where the first blank row is on sheet 2.

Thank-you and I hope that makes some sense!

 

[The_Macrotect]

Hi est1989,

Try this code on a copy of your work.

This code assumes there is no other data in Sheet1 column C or in Sheet2 columns D & E below the list we're copying from/pasting to.
It will skip any rows where Sheet1 column C is blank

Sub Copy_Data()
Dim lastrow As Long, x As Long, destD As Long, destE As Long

lastrow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
destD = Sheets("Sheet2").Cells(Rows.Count, "D").End(xlUp).Row + 1
destE = Sheets("Sheet2").Cells(Rows.Count, "E").End(xlUp).Row + 1


For x = 1 To lastrow
    If Sheets("Sheet1").Cells(x, 3).Value = "C" Then
        Sheets("Sheet1").Cells(x, 4).Copy
        Sheets("Sheet2").Cells(destD, 4).PasteSpecial
        destD = destD + 1
        Sheets("Sheet1").Cells(x, 5).Copy
        Sheets("Sheet2").Cells(destE, 5).PasteSpecial
        destE = destE + 1
    ElseIf Sheets("Sheet1").Cells(x, 3).Value = "D" Then
        Sheets("Sheet1").Cells(x, 6).Copy
        Sheets("Sheet2").Cells(destD, 4).PasteSpecial
        destD = destD + 1
        Sheets("Sheet1").Cells(x, 7).Copy
        Sheets("Sheet2").Cells(destE, 5).PasteSpecial
        destE = destE + 1
    Else
    End If
Next x

End Sub

Let me know how it works!

All the best,
Matt

 

[est1989]

Hi Matt,

Thank-you so much for your time. That code looks great. Exactly what I need! As soon as I have had the opportunity to expand it to my full data set I will let you know how it works. At first glance, it looks perfectly suitable!