1
votes

I would like to automatically populate multiple columns from one excel sheet to another sheet in the same worksheet. I've used ='Sheet1'!A1 , but that makes me drag it down every time I enter something new in Sheet1. Is it possible to do auto populate cells from Sheet1 to Sheet2 using VBA?

1
Is it possible to do auto populate cells from Sheet1 to Sheet2 using VBA? It is. Use code in a worksheet change event. - Scott Craner
Please note that SO is meant to be a source for assistance, but the general principle is for members to assist in your coding problem. It would imply that you should at least have tried something and then post your code and where you run into problems? and there are several similar questions with answers available? stackoverflow.com/questions/15931688/… - mtholen

1 Answers

0
votes

Automatic Worksheet Values Backup

  • This example will copy the values (not formulas, formatting...) of each cell being changed in a source worksheet to a destination worksheet. Multiple-area ranges are supported.
  • Copy the following code into the sheet module e.g. Sheet1 of the source worksheet.
  • Adjust the values of dstName (destination worksheet name) and ColsAddress (source worksheet columns address) appropriately.

The Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const ProcName As String = "Worksheet_Change"
    On Error GoTo clearError

    Const dstName As String = "Sheet2"
    Const ColsAddress As String = "A:H"
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(dstName)
    Dim rng As Range: Set rng = Intersect(Target, Columns(ColsAddress))
    
    If rng Is Nothing Then Exit Sub

    'Application.EnableEvents = False
    assignSameRangeValues rng, ws
    'Application.EnableEvents = True

ProcExit:
    Exit Sub

clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit

End Sub

Sub assignSameRangeValues( _
        rng As Range, _
        dst As Worksheet)

    Const ProcName As String = "assignSameRangeValues"
    On Error GoTo clearError
    
    If rng Is Nothing Then Exit Sub
    If dst Is Nothing Then Exit Sub
    
    Dim aRng As Range
    Application.ScreenUpdating = False
    For Each aRng In rng.Areas
        dst.Range(aRng.Address).Value = aRng.Value
    Next aRng
    Application.ScreenUpdating = True

ProcExit:
    Exit Sub

clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit

End Sub