Macro Copy and Paste Value and formatting in multiple same cells when condition is met.

[Simonjhp]

Hi all,
I am trying to create a macro to copy and paste Values and formatting In Columns M, O, AA:AE when column AF = "Y".
I have tried the following but i doesn't work.

I'd appreciate any help.

Thanks

Option Explicit
Sub PasteContitionalSpecial()
Dim lastrow As Long, r As Long
With ThisWorkbook.ActiveSheet
lastrow = .Range("AF" & .Rows.Count).End(xlUp).Row
For r = 2 To lastrow
If .Range("AF" & r).Value = "Y" Then
.Range("M" & r).Value = .Range("M" & r).Value
End If
Next r
End With
End Sub

I'm wondering if some variation of the following could work but everything I try fails.
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 2/22/2020 11:42:10 AM EST
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Column = 31 Then
Dim Lastrow As Long
Lastrow = Sheets("Open").Cells(Rows.Count, 13).End(xlUp).Row + 1
Dim ans As Long
ans = Target.Row
If Target.Value = "Y" Then
Rows(ans).Copy Sheets("open").Rows(Lastrow)

End If
End If
End Sub

 

[RobP]

Hi,
not sure if its the cause of your issue, but it could be one of them:

.Range("M" & r).Value = .Range("M" & r).Value

this is copying the data in M&r back to M&r if AF&r = "Y" (eg. the same location ?)

its not clear for us where / what you want to copy out of the columns you mentioned above ... ?

Rob

 

[Simonjhp]

Hi,
not sure if its the cause of your issue, but it could be one of them:

.Range("M" & r).Value = .Range("M" & r).Value

this is copying the data in M&r back to M&r if AF&r = "Y" (eg. the same location ?)

its not clear for us where / what you want to copy out of the columns you mentioned above ... ?

Rob

 

[Simonjhp]

Hi Rob,
What I am trying to do is: When I mark column AF as "Y" on sheet 1 I want to copy and paste the Value and formatting in column M on sheet 1. (So change the formula In column M to the value.) This happens on multiple rows.
Does that make sense? Sorry I'm not very good at Macros.

 

[RobP]

So your code is thus, which I took below, and changed columns for ease of showing results on my side.

Option Explicit
Sub PasteContitionalSpecial()
Dim lastrow As Long, r As Long
With ThisWorkbook.ActiveSheet
lastrow = .Range("AF" & .Rows.Count).End(xlUp).Row
For r = 2 To lastrow
If .Range("AF" & r).Value = "Y" Then
.Range("M" & r).Value = .Range("M" & r).Value
End If
Next r
End With
End Sub

My code, executed and did what you expected... that is, replace formulas in my Column D with the actual values instead.

Sub test()

Dim lastrow As Long, r As Long

With ThisWorkbook.ActiveSheet

    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row  'change "B" to "AF"
    For r = 2 To lastrow
        If .Range("B" & r).Value = "Y" Then 'change "B" to "AF"
            .Range("D" & r).Value = .Range("D" & r).Value  'change both "D" to "M" in your case
        End If
    Next r
    
End With

End Sub

Results : you can see some cells are values, some still have formulas where there is no "Y" ?

Book1
	A	B	C	D
1
2	3	Y		6
3	5	Y		10
4	7			14
5	9			18
6	4	Y		8
7	6			12
8	8			16
Sheet1

Cell Formulas
Range	Formula
D4:D5,D7:D8	D4	=A4*2

Let me know if my understanding is incorrect ..

cheers
Rob