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）在工作表中被合并＆＃34; omk＆＃34;，因此我试图使第二个循环跳过列d，同时在工作表中保留列d ＆＃34; WS＆＃34; ＆＃34;锁定＆＃34;当这个情况发生时。但是，当我运行代码时，它似乎是工作表中的列d＆＃34; ws＆＃34;没有被锁定？

我不确定，我已经足够清楚，所以如果你不能解决我的问题，请告诉我。

谢谢：）

Answer 1

当您有合并列时，可以使用offset方法填充下一列中的值。类似的东西：

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

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

1 个答案: