K Bizzy
K Bizzy

Reputation: 85

Keeping Conditional Formatting

Hi I'm busy with a VBA macro that copies data from one sheet to another, problem is whenever i paste the data to the other sheet, the conditional formatting falls off.It messes up with what i want to achieve. Isn't there a code I could use to keep conditional formatting. here is my code:

'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

Please Assist

Upvotes: 1

Views: 2072

Answers (1)

Mikisz
Mikisz

Reputation: 404

so I recommend to replace this:

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

with this:

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

Upvotes: 1

Related Questions