Question

我正在使用此代码从 -A ＆amp;中结束的工作表中复制/粘贴（通过保持价值和格式化） -B 组成一张Target Sheet：

Sub Merge_AllSheets_into_One()
   Dim Sheet As Worksheet
   Dim TargetRow As Long
   'Application.ScreenUpdating = True
   Sheets("Target Sheet").Range("A3:FN10000").Cells.clear
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False

   TargetRow = 3
   For Each Sheet In ActiveWorkbook.Sheets
      If Sheet.Name Like "*" & strSearch & "-A" Or _
         Sheet.Name Like "*" & strSearch & "-B" Then
         Sheets(Sheet.Name).Range("AA3:GN90").Copy
         With Worksheets("Target Sheet").Cells(TargetRow, 1)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
         End With
         TargetRow = TargetRow + 88
      End If
   Next
   Application.CutCopyMode = False

End Sub

复制的数据大小相同，不同工作表的范围相同。
问题是Target Sheet包含许多条件格式规则，这些规则在每次合并时都会发生变化。
也就是说，每次我将范围合并到Target Sheet时，它都会删除旧数据（这就是我想要的，删除或替换旧数据），并将新数据粘贴到另一个上。

如何在不更改条件格式适用范围的情况下将数据复制/粘贴（=合并）到Target Sheet？

更新

实际上，我从不同工作表复制的范围具有相同的范围，每个范围是88行("AA3:GN90")。它们包含合并的单元格：合并的单元格是每个范围的前四列仅：

- AA3：AA90
- AB3：AB90
- AC3：AC90
在四行 AD 中合并四行四行
的 AD3：AD6
的 AD7：AD10
等等直到 AD87：AD90
当复制/粘贴到目标工作表时，我希望保留这些合并的单元格，并将条件格式设置规则保留在目标工作表中。

快速说明：这些表格中的一些单元格还包含字体着色和单元格着色。如果可能的话，我也想保留它们。如果不是，则可以省略这种情况。

有关工作表和规则的更多信息：目标工作表中有超过30个条件格式设置规则。因此，每次从其他工作表导入新数据时清除单元格时，格式化范围会继续前进和更改。我不可能重写这些规则，因为出于数据控制和重复使用此VBA代码的原因，我需要为每个数据集运行此代码超过10次（数据控制原因）并查看代码的位置应用。花几天时间来重写这些规则的范围几乎是不可能的。

Answer 1

其中一些将取决于您使用的Excel版本。由于Excel 2010目前是主流版本，因此我将遵循该标准。

如果您尝试在目标工作表上保留CF规则和适用于：，则不应使用。Clear（又名全部清除 em>）命令。仅清除值/公式就足够了，您可以在.PasteSpecial中填写数字格式以覆盖现有的单元格格式。

Sub Merge_AllSheets_into_One()
    Dim ws As Worksheet
    Dim TargetRow As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    'only clear the contents - CF stays and cell number formats will be overwritten
    'why clear AA:FN if you are copying AA:GN below?
    Sheets("Target Sheet").Range("A3:FN10000").Cells.ClearContents

    TargetRow = 3
    For Each ws In ActiveWorkbook.Sheets
        With ws
            If .Name Like "*" & strSearch & "-A" Or _
              .Name Like "*" & strSearch & "-B" Then
                'are there ALWAYS 88 rows to copy?
                .Range("AA3:GN90").Copy
                With Worksheets("Target Sheet").Cells(TargetRow, 1)
                    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats 'this is a newer Paste Special option
                End With
                TargetRow = TargetRow + 88
            End If
        End With
    Next ws

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

根据您尝试使用的格式，这可能适用也可能不适用。如果除了手动单元格/行突出显示之外还需要数字格式以外的任何其他内容，最好只需用.Clear擦除平板，复制并粘贴然后重新定义CF规则适用于：然后再转到循环中的下一个工作表。

Answer 2

如果您的源数据没有条件格式，则应考虑xlPasteAllMergingConditionalFormats)

考虑您的代码，它应该是这样的：

Sub Merge_AllSheets_into_One()
   Dim Sheet As Worksheet
   Dim TargetRow As Long
   'Application.ScreenUpdating = True
   Sheets("Target Sheet").Range("A3:FN10000").Cells.clear
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False

   TargetRow = 3
   For Each Sheet In ActiveWorkbook.Sheets
      If Sheet.Name Like "*" & strSearch & "-A" Or _
         Sheet.Name Like "*" & strSearch & "-B" Then
         Sheets(Sheet.Name).Range("AA3:GN90").Copy
         With Worksheets("Target Sheet").Cells(TargetRow, 1)
            .PasteSpecial Paste:=xlPasteAllMergingConditionalFormats)
         End With
         TargetRow = TargetRow + 88
      End If
   Next
   Application.CutCopyMode = False

End Sub

保持条件格式不会更改“申请范围”

更新

2 个答案: