Copy and paste cell when changed

4

I'm starting to use VBA with the office package, as I still know little I'm having trouble getting this functionality.

I was trying to do something simple and needed help to understand how it works:

I need if one cell changes, its contents are copied to another one automatically, without having to click any button, eg

I have cell A1: B5

All cells are blank, if I fill in any information in cell A1, I need the value of it to be copied to cell B1, if I change cell A2, I need to change the value to cell B2 and so on.

I know I can do this with formulas, but I need the VBA syntax to start doing something more advanced.

    
asked by anonymous 06.11.2017 / 14:57

1 answer

2

Enter Event Code

Use the Worksheet_Change event, which must be placed inside the spreadsheet where the data is located. For example, in my case it was in Sheet1:

Code for a cell

The code is fired every time the worksheet has any changes and has a conditional if the change is performed in column A, then copies the values.

 Option Explicit
    Private Const B As Long = 2                  '<-- Coluna B
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo CleanExit
    Application.EnableEvents = False
    Dim Coluna As Long                           '<-- Coluna selecionada
    Dim linha As Long

    Coluna = Target.Column
    'Se ocorrer mudanças na coluna A
    If Coluna = 1 Then
        linha = Target.Row
        Cells(linha, B) = Cells(linha, Coluna)
    End If

CleanExit:
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Multi-cell code

Option Explicit
    Private Const B As Long = 2                  '<-- Coluna B
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo CleanExit
    Application.EnableEvents = False
    Dim Coluna As Long                           '<-- Coluna selecionada
    Dim linha As Long
    Dim Area
    Coluna = Target.Column

    'Caso mais de uma célula seja alterada
    If Target.Count > 1 And Coluna = 1 Then
        Dim rng As Range
        Set rng = Range(Target.Address)
        For Each Area In rng.Areas
            Area.Offset(, 1).Value = Area.Value
        Next
        GoTo CleanExit
    End If
    'Se ocorrer mudanças na coluna A
    If Coluna = 1 And Target.Count = 1 Then
        linha = Target.Row
        Cells(linha, B) = Cells(linha, Coluna)
    End If

CleanExit:
    Application.EnableEvents = True
    On Error GoTo 0
End Sub
    
14.11.2017 / 12:52