VBA copy one cell to another

Inuniform

New Member
Joined
Nov 15, 2016
Messages
47
Hi everybody,

Essentially I need VBA for the IF function. If a cell in column K says "Malfunction" then the value within that row of column J has to be copied to column M. I hope that's enough information otherwise please let me know!

Sincerely,
Inuniform
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Tetra201

MrExcel MVP
Joined
Oct 14, 2016
Messages
3,653
Is this what you need?
Code:
Sub Malf()
    For i = 1 To Range("K" & Rows.Count).End(xlUp).Row
        If Range("K" & i).Value = "Malfunction" Then _
            Range("M" & i).Value = Range("J" & i).Value
    Next i
End Sub
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,653
Office Version
  1. 2013
Platform
  1. Windows
Try this:

Code:
Sub Test()
Application.ScreenUpdating = False
Dim c As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "K").End(xlUp).Row
For Each c In Range("K1:K" & Lastrow)
    If c.Value = "Malfunction" Then c.Offset(, 2).Value = c.Offset(, -1).Value
Next
Application.ScreenUpdating = True
End Sub
 

Inuniform

New Member
Joined
Nov 15, 2016
Messages
47
Thanks for the quick response guys! Alright I have tried both of them, but they don't work. Probably it is something I am doing wrong with copying the code in the worksheet. In that particular worksheet I already have the following code
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.CountLarge > 1 Then Exit Sub
 Dim Rstart As Range, Rend As Range, Rdest As Range
 Dim destinationLastRow As Long, sSize As Long
     Set Rstart = Range("A" & Target.Row)
     Set Rend = Range("O" & Target.Row)
    
     If Target.Column = 4 Then
        If Target.Value = "Complete" Then
            With Sheet6 'Historic Register
                destinationLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            End With
            With Range(Rstart, Rend.Offset(, -1))
                sSize = .Count
                .Copy
            End With
            Set Rdest = Sheets("Historic Register").Range("A" & destinationLastRow).Resize(1, sSize)
            Rdest.PasteSpecial xlPasteValues
            Target.EntireRow.Delete Shift:=xlShiftUp
            'Sheet6.Range("B" & Target.Row & ":J" & Target.Row & "").ClearContents
            'Sheet6.Range("B" & Target.Row & ":J" & Target.Row & "").ClearContents
            Application.CutCopyMode = False
            'Rstart.Offset(1).Select
        End If
     End If
 End Sub

Can I just copy paste your code beneath this one or do I have to combine them?
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,653
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

The two scripts we provided are not auto sheet event scripts. They were both Module scripts. Which must be activated by clicking a button or using a shortcut key.

You did not say you wanted these scripts to run automatically.
 

Inuniform

New Member
Joined
Nov 15, 2016
Messages
47
The two scripts we provided are not auto sheet event scripts. They were both Module scripts. Which must be activated by clicking a button or using a shortcut key.

You did not say you wanted these scripts to run automatically.

Oh I'm sorry that's my mistake, I'm kind of new to this. Is there a possibility to make it an auto sheet event script?
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,653
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.CountLarge > 1 Then Exit Sub
 Dim Rstart As Range, Rend As Range, Rdest As Range
 Dim destinationLastRow As Long, sSize As Long
     Set Rstart = Range("A" & Target.Row)
     Set Rend = Range("O" & Target.Row)
    
     If Target.Column = 4 Then
        If Target.Value = "Complete" Then
            With Sheet6 'Historic Register
                destinationLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            End With
            With Range(Rstart, Rend.Offset(, -1))
                sSize = .Count
                .Copy
            End With
            Set Rdest = Sheets("Historic Register").Range("A" & destinationLastRow).Resize(1, sSize)
            Rdest.PasteSpecial xlPasteValues
            Target.EntireRow.Delete Shift:=xlShiftUp
            'Sheet6.Range("B" & Target.Row & ":J" & Target.Row & "").ClearContents
            'Sheet6.Range("B" & Target.Row & ":J" & Target.Row & "").ClearContents
            Application.CutCopyMode = False
            'Rstart.Offset(1).Select
        End If
     End If
 'New Part
 
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "K").End(xlUp).Row
 
    If Not Intersect(Target, Range("K1:K" & Lastrow)) Is Nothing Then
    If Target.Value = "Malfunction" Then Target.Offset(, 2).Value = Target.Offset(, -1).Value
End If
End Sub
 

Inuniform

New Member
Joined
Nov 15, 2016
Messages
47
It gives a bug in the following part:
Code:
If Not Intersect(Target, Range("K1:K" & Lastrow)) Is Nothing Then
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,653
Office Version
  1. 2013
Platform
  1. Windows
The line of code you say is erroring out is in a script you said you did not want to use because it is a module script and not a Auto sheet event script. And when I run that script it works.

I suspect your copying and pasting bits of code together which causes this problem. Show us the entire script which you say is not working.
 

Inuniform

New Member
Joined
Nov 15, 2016
Messages
47
@My aswer is this

I have made a button since I am working with a deadline and your initial code works perfectly! Thank you so much for your help and enjoy the holidays!!!

Inuniform
 

Watch MrExcel Video

Forum statistics

Threads
1,133,531
Messages
5,659,360
Members
418,499
Latest member
mbcmel

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top