防止條件格式更改適用范圍

Question

我正在使用此代碼將以-A和-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 （又名“ 全部清除” ）命令。 僅清除值/公式就足夠了，您可以在.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