VBA Copy paste special values based on cell reference

TomRain

New Member
Joined
Apr 4, 2019
Messages
3
Hi All,

I'm having some issues with VBA. I want the code to look up cells within a range, that when greater than zero, copies and pastes adjacent columns as values in the same location (to remove the formulas).

The lookup range is J10:J371, and if greater than zero, I want adjacent cells in column J,K,L to copy and paste as values.

For example, J52 = 2000, then J52:L52 copies and pastes as values in the same place.

I saw something similar on the below thread but I can't quite get it to work on mine.

https://www.mrexcel.com/forum/excel...aste-special-values-based-cell-reference.html

Thank you in advance.
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,996
Hello and welcome

This should do what you ask:

Code:
Sub HardWriteValue()
    Dim c As Range
    For Each c In Range("J10:J371")
        If c > 0 Then
            Application.EnableEvents = False
            c = c
            c.Offset(, 1) = c.Offset(, 1)
            c.Offset(, 2) = c.Offset(, 2)
            Application.EnableEvents = True
        End If
    Next c
End Sub
 

TomRain

New Member
Joined
Apr 4, 2019
Messages
3
Hello and welcome

This should do what you ask:

Code:
Sub HardWriteValue()
    Dim c As Range
    For Each c In Range("J10:J371")
        If c > 0 Then
            Application.EnableEvents = False
            c = c
            c.Offset(, 1) = c.Offset(, 1)
            c.Offset(, 2) = c.Offset(, 2)
            Application.EnableEvents = True
        End If
    Next c
End Sub
Thank you so much for the quick response, it worked perfectly! One more thing, what would I need to add to ensure the macro does the same process across all sheets within my file simultaneously?

Thanks again.
 

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,996
Just loop through all worksheets:

Code:
Sub HardWriteValue()
    Dim c As Range
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        For Each c In ws.Range("J10:J371")
            If c > 0 Then
                Application.EnableEvents = False
                c = c
                c.Offset(, 1) = c.Offset(, 1)
                c.Offset(, 2) = c.Offset(, 2)
                Application.EnableEvents = True
            End If
        Next c
    Next ws
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,102,302
Messages
5,486,052
Members
407,529
Latest member
netojose

This Week's Hot Topics

Top