Forum Discussion

Brass Contributor

Mar 11, 2021

Solved

Copy and Pasting the Cell Values from one sheet to another Sheet

When i press the run button Target.Address = "$B$6" Then cell is update to trigger the below code. I have been using below code which i run first time it copies the cell value from sht2 B4 and paste...

Mar 11, 2021

The two parts of the code interfere with each other because they write to the same row.

The first time you run the code, the first part of the code writes a value to column B in row 4 of Sheet3. This changes the last used column to B, so the second part of the code uses a different column than you expect: column O instead of column L (2+13 = 15).

When you run the code again, the last column is O, so the first part writes to column P, and the second part of the code writes to column AC (16+13 = 29).

Here is an improved version:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sht2 As Worksheet
    Dim sht3 As Worksheet
    Dim col As Long
    If Target.Address = "$B$6" Then
        Set sht2 = Sheets("Sheet2")
        Set sht3 = Sheets("Sheet3")
        'For 1st Table
        col = sht3.Cells(4, 10).End(xlToLeft).Column + 1
        If col = 10 Then
            MsgBox "You have used up all 8 positions for table 1!", vbExclamation
        Else
            If col = 3 Or col = 8 Then
                sht3.Cells(4, col).Value = sht2.Cells(4, 17).Value
            Else
                sht3.Cells(4, col).Value = sht2.Cells(4, 2).Value
            End If
        End If
        'For 2nd Table
        col = Application.Max(sht3.Cells(4, 20).End(xlToLeft).Column + 1, 12)
        If col = 20 Then
            MsgBox "You have used up all 8 positions for table 2!", vbExclamation
        Else
            If col = 13 Or col = 18 Then
                sht3.Cells(4, col).Value = sht2.Cells(4, 21).Value
            Else
                sht3.Cells(4, col).Value = sht2.Cells(4, 6).Value
            End If
        End If
    End If
End Sub

HansVogelaar

MVP

Mar 11, 2021

ShazSh

The two parts of the code interfere with each other because they write to the same row.

When you run the code again, the last column is O, so the first part writes to column P, and the second part of the code writes to column AC (16+13 = 29).

Here is an improved version:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sht2 As Worksheet
    Dim sht3 As Worksheet
    Dim col As Long
    If Target.Address = "$B$6" Then
        Set sht2 = Sheets("Sheet2")
        Set sht3 = Sheets("Sheet3")
        'For 1st Table
        col = sht3.Cells(4, 10).End(xlToLeft).Column + 1
        If col = 10 Then
            MsgBox "You have used up all 8 positions for table 1!", vbExclamation
        Else
            If col = 3 Or col = 8 Then
                sht3.Cells(4, col).Value = sht2.Cells(4, 17).Value
            Else
                sht3.Cells(4, col).Value = sht2.Cells(4, 2).Value
            End If
        End If
        'For 2nd Table
        col = Application.Max(sht3.Cells(4, 20).End(xlToLeft).Column + 1, 12)
        If col = 20 Then
            MsgBox "You have used up all 8 positions for table 2!", vbExclamation
        Else
            If col = 13 Or col = 18 Then
                sht3.Cells(4, col).Value = sht2.Cells(4, 21).Value
            Else
                sht3.Cells(4, col).Value = sht2.Cells(4, 6).Value
            End If
        End If
    End If
End Sub

ShazSh

Brass Contributor

Mar 11, 2021

Thank you very vey much for this great help.

ShazSh

Brass Contributor

Mar 11, 2021

Is there a way that i press the button once and all values will loaded automatically in shet3 rather than running the code 8th time.

HansVogelaar

MVP

Mar 11, 2021

ShazSh

Change the macro CellVal (the macro called by the command button on Sheet3) to:

Sub CellVal()
    Dim sht1 As Worksheet
    Dim ECell As Range
    Dim r As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Range("B4:S4").ClearContents
    Application.EnableEvents = True
    Set sht1 = Sheets("Sheet1")
    Set ECell = sht1.Cells(6, 2)
    For r = 27 To 34
        If sht1.Cells(r, 3).Value <> "" Then
            ECell.Value = sht1.Cells(r, 3).Value
        End If
    Next r
    Application.ScreenUpdating = True
End Sub