Question

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

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

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

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

第 4 次运行它复制 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

第 4 次运行代码，它将复制 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

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

1 个答案: