Forum Discussion
Copy and Pasting the Cell Values from one sheet to another Sheet
- 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
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- ShazShMar 11, 2021Brass ContributorIs there a way that i press the button once and all values will loaded automatically in shet3 rather than running the code 8th time.
- HansVogelaarMar 11, 2021MVP
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- ShazShMar 11, 2021Brass ContributorThank you very much I truly appreciate your help. Thanks