将一行中的每个单元格按照未合并的单元格向左移动

Question

我有一些代码可以从每周更新的名为"计数"的库存表中复制一列值，并将它们粘贴并转置到另一张"每周板数"上的下一个空行中以保存记录。

'selects and copies ranges containg total plate counts'
Dim range1 As Range, range2 As Range, multipleRange As Range
Set range1 = Sheets("Counts").Range("F3:F32")
Set range2 = Sheets("Counts").Range("F35:F39")
Set range3 = Sheets("Counts").Range("F42:F46")
Set multipleRange = Union(range1, range2, range3)
'copies entire range of counts'
multipleRange.Copy
'transposes and pastes counts into next blank row on plates per week sheet'
Sheets("Plates per Week").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Transpose:=True

"计数"的范围包括一些垂直合并的单元格(我知道它们是魔鬼)。现在我有一行代码可以取消合并"每周板数"中的每个单元格

'unmerges cells all cells in sheet'
Sheets("Plates per Week").Cells.UnMerge

这显然搞砸了标题，这些值应该落在我在"每周板数"上创建的表格中。

我目前的运行想法是在每个已取消合并的单元格之后，将每个单元格向左移动 1。我知道"计数"中的合并单元格将始终是F6:F28单元格，它们将始终以"每周板数"的E3:AB3结束。不知道如何对此进行编码，将不胜感激任何想法，因为我对 VBA 不是很好。

Answer 1

我认为最好使用稍微不同的方法不使用复制/粘贴：

Sub Tester()

Dim rng As Range, c As Range, arr, i As Long

Set rng = Sheets("Counts").Range("F3:F32,F35:F39,F42:F46") 'source range
ReDim arr(1 To 1, 1 To rng.Cells.Count) 'resize to max. possible size

For Each c In rng.Cells 'loop over the cells in the source range
'is this cell either unmerged or the first cell in a merged area?
If c.Address = c.MergeArea.Cells(1).Address Then
i = i + 1
arr(1, i) = c.Value 'add the cell value
End If
Next c

'put the values on the sheet
Sheets("Plates per Week").Range("B" & Rows.Count). _
End(xlUp).Offset(1, 0).Resize(1, i).Value = arr
End Sub