将单元格值从一张表复制并粘贴到另一张表

Question

当我按下运行按钮Target.Address = "$B$6" Then 时，单元格会更新以触发以下代码。

我一直在使用下面的代码，我第一次运行它从sht2 B4复制单元格值并粘贴到sht3 B4。

第二次运行复制sht2 Q4并粘贴到sht3 C4的代码。

第三次运行复制sht2 B4并粘贴到sht3 D4的代码。

第四次运行复制sht2 B4并粘贴到sht3 E4的代码。

第 5 次运行复制sht2 B4 并粘贴到sht3 F4 的代码。

第 6 次运行复制sht2 B4 并粘贴到sht3 G4 的代码。

第 7 次运行复制sht2 Q4 并粘贴到sht3 H4 的代码。

第 8 次运行复制sht2 B4 并粘贴到sht3 I4 的代码。它运行良好，我附上了一个可以下载的工作簿，可能更容易理解。

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

我想要第二张桌子也一样

第一次运行代码，它将复制sht2 F4 并粘贴到sht3 L4

第二次运行代码，它将复制sht2 U4并粘贴到sht3 M4

第三次运行代码，它将复制sht2 F4 并粘贴到sht3 N4

第四次运行代码，它将复制sht2 F4并粘贴到sht3 O4

第 5 次运行代码，它将复制 sht2 F4 并粘贴到 sht3 P4

第 6 次运行代码，它将复制 sht2 F4 并粘贴到 sht3 Q4

第 7 次运行代码，它将复制 sht2 U4 并粘贴到 sht3 R4

第 8 次运行代码，它将复制 sht2 F4 并粘贴到 sht3 S4

所以我尝试制作下面的一段代码并用上面的代码添加它，其中第一个表的代码工作正常，但第二个表没有更新值并且没有发生错误。

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

任何解决问题的帮助将不胜感激。

https://drive.google.com/file/d/1JIrRMdoexFS2QyoaTX6_yDw31muEEFTf/view?usp=sharing

Sht3 图片

Answer 1

可能是这样的（未经测试）：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim sht2 As Worksheet
    Dim sht3 As Worksheet
    Dim col As Long, i As Long
    Set sht2 = Sheets("Sheet2")
    Set sht3 = Sheets("Sheet3")
    
    If Target.Address = "$B$6" Then
        'run 8 times....
        For i = 1 To 8
        
            col = sht3.Cells(4, "J").End(xlToLeft).Column + 1
            
            sht3.Cells(4, col).Value = IIf(col = 3 Or col = 8, sht2.Cells(4, 17).Value, _
                                                               sht2.Cells(4, 2).Value)
            
            col = sht3.Cells(4, Columns.Count).End(xlToLeft).Column + 1
            If col < 12 Then col = 12  'min column for green-shaded area
        
            sht3.Cells(4, col).Value = IIf(col = 12 Or col = 17, sht2.Cells(4, 21).Value, _
                                                                 sht2.Cells(4, 6).Value)
       Next i

    End If

End Sub