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

[ShazSh]

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 into sht3 B4.

2nd time runs the code it copies the sht2 Q4 and paste into sht3 C4.

3rd time runs the code it copies the sht2 B4 and paste into sht3 D4.

4th time runs the code it copies the sht2 B4 and paste into sht3 E4.

5th time runs the code it copies the sht2 B4 and paste into sht3 F4.

6th time runs the code it copies the sht2 B4 and paste into sht3 G4.

7th time runs the code it copies the sht2 Q4 and paste into sht3 H4.

8th time runs the code it copies the sht2 B4 and paste into sht3 I4. and it is working perfectly i have attached a workbook which can be download and might be better for understanding.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$6" Then
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim col As Long
Set sht2 = Sheets("Sheet2")
Set sht3 = Sheets("Sheet3")

col = sht3.Cells(4, sht3.Columns.Count).End(xlToLeft).Column + 1
If col = 3 Or 8 Then
    sht2.Cells(4, 17).copy
Else
    sht2.Cells(4, 2).copy
End If
sht3.Cells(4, col).PasteSpecial xlPasteValues

End If
End Sub

and i want same thing for 2nd Table that is

1st time runs the code it will copy the sht2 F4 and paste into sht3 L4

2nd time runs the code it will copy the sht2 U4 and paste into sht3 M4

3rd time runs the code it will copy the sht2 F4 and paste into sht3 N4

4th time runs the code it will copy the sht2 F4 and paste into sht3 O4

5th time runs the code it will copy the sht2 F4 and paste into sht3 P4

6th time runs the code it will copy the sht2 F4 and paste into sht3 Q4

7th time runs the code it will copy the sht2 U4 and paste into sht3 R4

8th time runs the code it will copy the sht2 F4 and paste into sht3 S4

so i tried and make below piece of code and added it with above code, where code for 1st table was working fine but 2nd Table is not updating the values and no error occurs.

col2 = sht3.Cells(4, sht3.Columns.Count).End(xlToLeft).Column + 13
   If col2 = 13 Or col2 = 18 Then
       sht2.Cells(4, 21).copy
    Else
      sht2.Cells(4, 6).copy
    End If
    sht3.Cells(4, col2).PasteSpecial xlPasteValues

Any help to solve the problem will be greatly appreciated.

[#2 · Accepted solution]

@ShazSh 

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

[#3]

Thank you very vey much for this great help.

[#4]

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.

[#5]

@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

[#6]

Thank you very much I truly appreciate your help. Thanks