如果在 A 列中找到字符串匹配，则将单元格文本从 Book1 上的 E 和 F 复制到 Book2？

Question

我会尽量简明扼要地解释这一点，如果有什么不明白的地方请插话。

所以我有一个我每个月生成的服务器数据的清单电子表格（称为 Book1），但是有几列需要手动更新（E、H、I、J、K），因为这些信息会发生变化。 我需要做的是在月底将更新的信息复制到下一个新生成的电子表格（称为 Book2），如果 A 列中的主机名找到彼此（服务器一直在创建和删除）。

我有一些 VBA 可以完美工作，但仅适用于 E 和 F 列。我希望有人可以编辑它以复制 E、H、I、J、K。

Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("Book1.xlsx").Sheets(1)
Set sh2 = Workbooks("Book2.xlsx").Sheets(1)
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                If fn.Offset(, 4).Value <> c.Offset(, 4).Value Or fn.Offset(, 5).Value <> c.Offset(, 5).Value Then
                    c.Offset(, 4).Resize(, 2).Copy fn.Offset(, 4)
                End If
            End If
        Set fn = Nothing
    Next
End Sub

旧九月盘点：

10月新品盘点：

谢谢！

格雷格

Answer 1

为什么不直接将c.Offset(, 7).Resize(, 4).Copy fn.Offset(, 7)添加到现有代码中？

Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("Book1.xlsx").Sheets(1)
Set sh2 = Workbooks("Book2.xlsx").Sheets(1)
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                c.Offset(, 4).Resize(, 2).Copy fn.Offset(, 4)
                c.Offset(, 7).Resize(, 4).Copy fn.Offset(, 7)
            End If
        Set fn = Nothing
    Next
End Sub

Answer 2

代替：

c.Offset(, 4).Resize(, 2).Copy fn.Offset(, 4)

和

sh1.Range("E" & c.Row).Copy sh2.Range("E" & fn.Row) 'E
sh1.Range("H" & c.Row & ":K" & c.Row).Copy sh2.Range("H" & fn.Row & "K" & fn.Row) 'because H,I,J,K are adyacent, we can do it in 1 line code