Vba 保留条件格式

您好，我正忙着使用VBA宏将数据从一张工作表复制到另一张工作表，问题是每当我将数据粘贴到另一张工作表时，条件格式都会下降。这会破坏我想要实现的目标。难道没有一个代码可以用来保存条件格式吗。这是我的密码：

'In this example I am Copying the Data from Sheet1 (Source) to Sheet2 
(Destination)
Sub sbCopyRangeToAnotherSheet()
'Method 1
Application.ScreenUpdating = False


'Set active sheet as current sheet
temp = ActiveSheet.Index

'Clear contents in sheet 1
Sheets("Sheet1").Select
Range("B22").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
'Clear Specials in Sheet 1
Range("B13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'Return to current sheet and copy required contents
Sheets(temp).Select
Range("D51").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

'Paste data in sheet 1
Worksheets("Sheet1").Activate

k = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Range("B22").Select  ' kindly change the code to suit your paste location
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy specials over to sheet1

Sheets(temp).Select
Range("i36").Select

p = Range(Selection, Selection.End(xlDown)).Count


j = 0

For k = 1 To p
Sheets(temp).Select

t = Range("i36").Offset(k - 1, 0).Value
s = Range("j36").Offset(k - 1, 0).Value


If t = True Then
Sheets("Sheet1").Select
j = j + 1
Range("b13").Offset(j - 1, 0).Value = s

Else: End If

Next k

'Delete Empty Rows In UPL

Dim iRow As Long, lastRow As Long

Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'qualify your sheet

lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row 'find last used row

For iRow = lastRow To 1 Step -1 'run from last used row backwards to row 1
    If ws.Cells(iRow, 3).Text = "#N/A" Or _
       ws.Cells(iRow, 4).Text = "#N/A" Then
        ws.Rows(iRow).Delete
    End If
Next iRow

' Paste Unit Into UPL

Sheets(temp).Select
temp = Sheets(temp).Range("d35").Value

model = Range("D26").Value
Sheets("Sheet1").Select
Range("B11").Value = temp & " " & model


End Sub

---

请协助

，因此我建议更换：

 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

为此：

Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False 'so that Excel will not be in the copy mode

---

可能是

Paste:=xlPasteAllMergingConditionalFormats

而不是

Paste:=xlPasteValues

？我尝试过这样做，但有些单元格值有公式，所以我得到了一个“#REF”另一页上出现错误。您可以尝试执行两次

PasteSpecial

：一次使用

xlPasteAllMergingConditionalFormats

，然后使用

xlPateValues

。试试看。