Question

您好我忙于将数据从一张纸复制到另一张的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

请协助

Answer 1

所以我建议替换它：

 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

保持条件格式

1 个答案: