使用循环将未合并的单元格从一个工作表复制到另一个工作表中的合并单元格

Question

我已经做了很多尝试和失败，并在互联网上搜索解决方案，但我似乎无法确切地弄清楚如何解决我的问题。现在我希望你们能帮助我。

我正在尝试将一个单元格范围（未合并）从一个工作表 (ws) 复制到另一个包含另一个工作表 (omk) 中合并单元格的范围。我必须为 20 个左右的范围执行此操作，所以我使用的是循环。我目前写的代码贴在下面：

Dim omk, ws As Worksheet
Dim a, b, i, y, z As Integer
Dim x As Range

Set omk = Sheets("Omkostningsmodel")
Set ws = ActiveSheet

omk.Activate

a = 173
i = 187
For Each cell In Range("C187", "C206")
    z = 3
    b = 3
    For Each x In Range(Cells(i, z), Cells(i, 22))
        x.Value = ws.Cells(a, b)
        z = z + 1
        b = b + 1
        If z = 4 Or z = 13 Or z = 16 Then
            z = z + 1
        End If
    Next x
    a = a + 1
    i = i + 1
Next cell

我的问题是 c 列和 d 列（3 和 4）在工作表“omk”中合并，因此我试图使第二个循环跳过 d 列，同时保持工作表“ws”中的 d 列“锁定” “ 当这件事发生时。但是，当我运行代码时，工作表“ws”中的 d 列似乎没有被锁定？

我不确定，我已经很清楚了，所以如果你不能理解我的问题，请告诉我。

谢谢:)

Answer 1

当您有合并列时，您可以使用偏移方法填充下一列中的值。比如：

Dim omk as Worksheet, ws As Worksheet
Dim a as Integer, b As Integer, i As Integer
Dim y As Integer, z As Integer, Coloffset As Integer
Dim x As Range, cell As Range

Set omk = Sheets("Omkostningsmodel")
Set ws = ActiveSheet

omk.Activate

a = 173
i = 187

For Each cell In Range("C187", "C206")
    z = 3
    b = 3
    Coloffset = 0
    For Each x In Range(Cells(i, z), Cells(i, 22))
        If x.Column = 4 Or x.Column = 13 Or x.Column = 16 Then
            Coloffset = Coloffset + 1
        End If

        x.Offset(0, Coloffset).Value = ws.Cells(a, b)

        b = b + 1
    Next x
    a = a + 1
    i = i + 1
Next cell