Copy background color from one cell to cell in separate sheet using ms-excel?

A

asadz

New member
Joined
Sep 18, 2015
Messages
7
Reaction score
0
Points
0
I want to copy background color for example sheetA cell A1 to
sheet B A1.


The cell A1 is using conditional formatting, I can copy simple but not with conditional formatting enabled.


Here is the code




Dim strTemp As String


strTemp = Worksheets("sheetB").Range("A1").Formula
Worksheets("sheetA").Range("A1").Copy
Worksheets("sheetB").Range("A1").PasteSpecial xlPasteAllMergingConditionalFormats
Worksheets("sheetB").Range("A1").Formula = strTemp
Click to expand...

The issue , is that my target cells are not populated correctly
 

Attachments

  • Animation.jpg
    Animation.jpg
    25.4 KB · Views: 16
Copy format cells by Conditional formatting into another sheet with VBA

asadz said:
I want to copy background color for example sheetA cell A1 to
Click to expand...
Hi @asadz
This is your first post on the forum, you welcome.
In the future, can you practice with your message attach example files (not the image, in the image can not do anything).
See this link and example.

It would look something like this as below.
Code: 
Sub Keep_Format()
    Dim ws As Worksheet
    Dim mySel As Range, aCell As Range
'---------------------------
    Dim strTemp As String
'---------------------------
    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    '~~> Change this to the relevant range
    Set mySel = ws.Range("A1:A10")

    For Each aCell In mySel
        With aCell
          .Font.FontStyle = .DisplayFormat.Font.FontStyle
          .Interior.Color = .DisplayFormat.Interior.Color
          .Font.Strikethrough = .DisplayFormat.Font.Strikethrough
        End With
    Next aCell

    'mySel.FormatConditions.Delete

    '
    '~~> Now Do the copying
'------------------------------
strTemp = Worksheets("sheet1").Range("A1").Formula 'source
Worksheets("sheet1").Range("A1").Copy 'source
Worksheets("sheet2").Range("A1").PasteSpecial xlPasteAllMergingConditionalFormats 'destination
'------------------------------
    '~~> Once you are done, close the sorce worksheet without saving
End Sub
 
Thanks for the warm welcome. I was not allowed to upload, or hyper-link due to my points which is at 0 in community.

I run you code and got error on line,
strTemp = Worksheets("People").Range("G3:G9").Formula '
Click to expand...

the error was
"Run-time error '13': Type mismatch"
Click to expand...
I corrected this by changing this declaration

from
Dim strTemp As String
Click to expand...
to
Dim strTemp As Variant
Click to expand...

But then the effected cells is getting values pasted in it as well which I don't want I just want background, also i revised the code to specify range which means updated code is

Sub Keep_Format()
Click to expand...
Dim ws As Worksheet
Dim mySel As Range, aCell As Range
'---------------------------
Dim strTemp As String
'---------------------------
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("People")
'~~> Change this to the relevant range
Set mySel = ws.Range("G3:G9")


For Each aCell In mySel
With aCell
.Font.FontStyle = .DisplayFormat.Font.FontStyle
.Interior.Color = .DisplayFormat.Interior.Color
.Font.Strikethrough = .DisplayFormat.Font.Strikethrough
End With
Next aCell


'mySel.FormatConditions.Delete


'
'~~> Now Do the copying
'------------------------------
strTemp = Worksheets("People").Range("G3:G9").Formula 'source
Worksheets("People").Range("G3:G9").Copy 'source
Worksheets("Summary").Range("F1").PasteSpecial xlPasteAllMergingConditionalFormats 'destination
'------------------------------
'~~> Once you are done, close the sorce worksheet without saving
End Sub
Click to expand...
I have to wait to get 5 points before I can put entire *.xls as attach.
Click to expand...
 
Thanks for informing, I have given reference to original question now
 
I have 4 points its not allowing me to put hyperlinks anywhere.
 
Working now with code

Sub Keep_Format()
Dim ws As Worksheet
Dim mySel As Range, aCell As Range
'---------------------------
Dim strTemp As Variant
'---------------------------
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("People")
'~~> Change this to the relevant range
Set mySel = ws.Range("G3:G9")


For Each aCell In mySel
With aCell
.Font.FontStyle = .DisplayFormat.Font.FontStyle
.Interior.Color = .DisplayFormat.Interior.Color
.Font.Strikethrough = .DisplayFormat.Font.Strikethrough
End With
Next aCell


'mySel.FormatConditions.Delete


'
'~~> Now Do the copying
'------------------------------
strTemp = Worksheets("Summary").Range("F15:F21").Formula
Worksheets("People").Range("G3:G9").Copy 'source
Worksheets("Summary").Range("F15:F21").PasteSpecial xlPasteAllMergingConditionalFormats




Worksheets("Summary").Range("F15:F21").Formula = strTemp




'------------------------------
'~~> Once you are done, close the sorce worksheet without saving
End Sub
Click to expand...
 
You must log in or register to reply here.
Back
Top