Copying specific cells from rows containing certain text

[Chirolove]

Hello all,

I am trying to copy/paste specific cells from rows that contain the word "YES" into another worksheet.

Let me say that I am brand new to VBA and just starting to understand, but am far from mastering this art.

So far, this is what I have; it copies the cells from column D to AA, but I only really need the values from columns D and P:AA (E:O are not needed).

Is it also possible to paste these values beginning in the target sheet's column B? I need the current values from column A to stay there and not be replaced.

Thank you very much in advance for your replies! I've been trying to figure this out for a while.

Code:

Sub CopyYes()


    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet


    Set Source = ActiveWorkbook.Worksheets("2020 Budget")
    Set Target = ActiveWorkbook.Worksheets("Shutdown 2020")


    j = 4     ' Paste starting in 4th row of target worksheet
    For Each c In Source.Range("O7:O500")
           If c = "YES" Then
           Source.Range("D" & c.Row & ":AA" & c.Row).Copy Target.Rows(j) 'Copy from cells D to AA
           j = j + 1
        End If
    Next c

End Sub

 

[My Aswer Is This]

Try this:

Sub Copy_Range()
'Modified 7/3/2019 2:55:47 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim r As Long
r = 4
For i = 7 To 500
    With Sheets("2020 Budget")
        If .Cells(i, "O").Value = "Yes" Then
            .Cells(i, "D").Copy Sheets("Shutdown 2020").Cells(r, "B")
            .Cells(i, "P").Resize(, 12).Copy Sheets("Shutdown 2020").Cells(r, "C")
            r = r + 1
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub

 

[Chirolove]

WOW, thank you My Aswer Is This!

Works like a charm! I see what you did and it makes sense, I did not know the .Resize function could help with copying sets of cells like that!

Very clear code, thank you very much for the help. Is there a quick way to modify the code to maintain the target formatting, thus copying only the values? If not, then don't worry, this is exactly what I needed and formatting is quite easy to do separately.


While I am here, I have another favor to ask, if you have the time and will. I am trying to make a code to do the following:
(Worksheet "2020 Budget" has a unique "functional location" code in column C corresponding to a database in worksheet "JB WBS" where these unique codes are listed in column H)
1: Search in worksheet "JB WBS" for the "functional location" code listed in row 7 of the worksheet "2020 Budget".
2: Move 2 cells left
3: Copy this cell
4: Paste this cell in worksheet "2020 Budget" in column D, in the same 7th row, just beside the "functional location" code.
5: Repeat this process for rows 7-500 automatically, which all have a different code, so that all codes are searched for and the cells copied at once and listed in column D of "2020 Budget".

I know the code should use the Search or LookIn functions, as well as the Offset function to target a specified cell distant from the search result cell, but I have no idea how to code this one.
If this is too complicated, I can create another thread without a problem!

Thank you so much for your help and have a great day.
Nicolas

 

[Chirolove]

Hey Aswer,

EDIT: I got the "Find" code to work finally, so all I need now is to keep the formatting when pasting the cells with your code.

Thanks again!

 

[My Aswer Is This]

Try this for pasting only values:

Sub Copy_Range()
'Modified  7/3/2019  1:08:51 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim r As Long
r = 4
For i = 7 To 500
    With Sheets("2020 Budget")
    If .Cells(i, "O").Value = "Yes" Then
        .Cells(i, "D").Copy: Sheets("Shutdown 2020").Cells(r, "B").PasteSpecial xlValues
        .Cells(i, "P").Resize(, 12).Copy: Sheets("Shutdown 2020").Cells(r, "C").PasteSpecial xlValues
         r = r + 1
        End If
End With
Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Not sure If you have another question here or not.

 

[Chirolove]

Hey Aswer,

This is perfect! I had tried adding the ".PasteSpecial xlValues" a few hours ago myself and was getting an error message; I had no idea why. Turns out by reading your code I found out I had a colon missing after .Copy

Thank you very much for your help Aswer! You've been an immense help and you've definitely saved me several hours of headaches. I have all I need now.

Sincerely,
Nicolas

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Hey Aswer,

This is perfect! I had tried adding the ".PasteSpecial xlValues" a few hours ago myself and was getting an error message; I had no idea why. Turns out by reading your code I found out I had a colon missing after .Copy

Thank you very much for your help Aswer! You've been an immense help and you've definitely saved me several hours of headaches. I have all I need now.

Sincerely,
Nicolas

 

[My Aswer Is This]

With Excel you can do things all different ways.
Like here are four different ways to do things:
Try this on a empty sheet.
You should be able to see the logic.

Sub Excel_And_More()
'Modified  7/3/2019  1:54:37 PM  EDT
Cells(1, 1).Value = "Alpha"
Cells(2, 1).Value = "Bravo"
Cells(3, 1).Value = "Charlie"
'Or
Cells(1, 2).Value = "Delta": Cells(2, 2).Value = "Echo": Cells(3, 2).Value = "Foxtrot"
'Or
[C1].Value = "Golf"
[C2].Value = "Hotel"
[C3].Value = "India"

'Or
Dim Del As Variant
Dim i As Long
Dim ans As Long
Del = Array("Juliet", "Kilo", "Lima")
ans = UBound(Del)
    For i = 1 To ans + 1
        Cells(i, 4).Value = (Del(i - 1))
    Next
End Sub

 

[Chirolove]

Makes sense, indeed! I'm learning gradually and posts like this help with understanding the logic that sometimes is missing when scripting, thank you for taking the time it means a lot

Have a nice day!

With Excel you can do things all different ways.
Like here are four different ways to do things:
Try this on a empty sheet.
You should be able to see the logic.

Sub Excel_And_More()
'Modified  7/3/2019  1:54:37 PM  EDT
Cells(1, 1).Value = "Alpha"
Cells(2, 1).Value = "Bravo"
Cells(3, 1).Value = "Charlie"
'Or
Cells(1, 2).Value = "Delta": Cells(2, 2).Value = "Echo": Cells(3, 2).Value = "Foxtrot"
'Or
[C1].Value = "Golf"
[C2].Value = "Hotel"
[C3].Value = "India"

'Or
Dim Del As Variant
Dim i As Long
Dim ans As Long
Del = Array("Juliet", "Kilo", "Lima")
ans = UBound(Del)
    For i = 1 To ans + 1
        Cells(i, 4).Value = (Del(i - 1))
    Next
End Sub