Question

如下所示，我目前正在使用

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim src as Range, dest as Range
Dim mergeAddress as String
Set src = Range("C9")
Set dest = Worksheets("FRONT").Range("G7")
mergeAddress = dest.MergeArea.Address
If Not Intersect(Target,src) Is Nothing Then
dest.MergeArea.Cells(1).Value = src.Value
src.Copy
dest.PasteSpecial xlPasteFormats
dest.Parent.Range(mergeAddress).Merge
End If
End Sub

我仍在使用此代码丢失格式，例如大胆，色彩等。

任何帮助将不胜感激。谢谢。

Answer 1

这有点棘手，也许这会有所帮助。合并细胞是一种痛苦的工作。在这种情况下，我认为你可以通过以下方式解决问题：

获取合并区域的地址
复制/粘贴格式（这将取消合并单元格）
根据上面（1）中获得的地址重新合并单元格

从一个单元格复制到合并区域

这是我测试的例子，其中[A1]有一个由[A1：C3]组成的MergeArea。此示例假设您将一个单元格复制到合并单元格（例如，＆＃34; H1＆＃34;被复制到＆＃34; A1：C3＆＃34;

Sub foo()
Dim src As Range, dest As Range
Dim mergeAddress As String

Set src = [H3]
Set dest = [A1]

'First, put the value in the merged cells:
dest.MergeArea.Cells(1).Value = src.Value = src.Value

'Then, the formatting:
'1. Get the mergeArea.Address
mergeAddress = dest.MergeArea.Address
'2. Copy & paste formatting (this unmerges the cells)
src.Copy
dest.PasteSpecial (xlPasteFormats)
'3. Re-merge the cells:
Range(mergeAddress).Merge

End Sub

更新您的代码：

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim src as Range, dest as Range
Dim mergeAddress as String
Set src = Range("C9")
Set dest = Worksheets("FRONT").Range("G7")
mergeAddress = dest.MergeArea.Address
If Not Intersect(Target,src) Is Nothing Then
    dest.MergeArea.Cells(1).Value = src.Value
    src.Copy
    dest.PasteSpecial xlPasteFormats
    dest.Parent.Range(mergeAddress).Merge
End If
End Sub

从合并区域复制（完整副本）

从合并单元格中复制更容易，您可以执行以下操作，复制整个合并区域并粘贴到目标位置：

src.MergeArea.Copy dest

Answer 2

我找到了解决方案：

首先：写一个代码来选择合并单元格中的一个单元格（它应该选择整个合并单元格）

第二：编写代码以复制选定的单元格。

示例：我的电子表格与一周中的每一天都在一行，但是每周的每一天都会与列＃34; A＆＃34;和＆＃34; B＆＃34;。下面的代码将选择并复制所有数据，包括其余的合并单元格。

Range(Cells.Find("Monday").Address, Cells.Find("Sunday").Address).Select
Selection.copy

粘贴数据，使用以下内容：

Range("A30").PasteSpecial xlPasteAll

宏将复制的单元格复制到另一个合并的单元格，同时保持格式

2 个答案: