保持条件格式

您好，我忙于一个VBAmacros，从一个表复制数据到另一个，问题是每当我粘贴到另一个表的数据，条件格式脱落。它混乱了我想达到什么。 没有我可以用来保留条件格式的代码。 这里是我的代码：

'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 

请协助

Answer 1

所以我build议replace这个：

  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