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

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
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
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
It gives a bug in the following part:
Code:
If Not Intersect(Target, Range("K1:K" & Lastrow)) Is Nothing Then
 
Upvote 0
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.
 
Upvote 0
@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
 
Upvote 0

Forum statistics

Threads
1,213,511
Messages
6,114,054
Members
448,543
Latest member
MartinLarkin

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
Back
Top