How to code VBA to paste values or formulas based on font color?

问题

Still new to VBA and need help modifying some existing code.

Several IF statements need to occur in the new code: If copied font is green, paste as values and change font color from green to blue. If copied font is anything other than green, paste as formulas.

Sub InvestorModelMacro()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False

Dim r As Range, ws As Worksheet

For Each r In Worksheets("Asset Dashboard").Range("C6:C9")   'go through each cell in DV list
    If Len(r) > 0 Then                                       'only do something if cell not empty
       Worksheets("Live").Range("D3").Value = r.Value        'transfer value to cell D3 of 'Live' tab
       Application.Calculate
       Set ws = Worksheets.Add                               'add new sheet
       ws.Name = Worksheets("Investor Model").Range("D3")    'renames new sheet after selected asset
       Worksheets("Investor Model").Cells.Copy
       ws.Range("A1").PasteSpecial xlValues                   'copy values only from Investor Model to new sheet
       ws.Range("A1").PasteSpecial xlFormats                 'copy formats only from Investor Model to new sheet
       ActiveWindow.DisplayGridlines = False                 'turns off gridlines

End If
Next r

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

Unfortunately, the code below is still returning formulas for all cells pasted into new worksheets. I need the green font to be pasted as values, and all other font colors to remain as formulas...

Sub InvestorModelMacro()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False

Dim r As Range, ws As Worksheet

For Each r In Worksheets("Asset Dashboard").Range("C6:C9")   'go through each cell in DV list
    If Len(r) > 0 Then                                       'only do something if cell not empty
       Worksheets("Live").Range("D3").Value = r.Value        'transfer value to cell D3 of 'Live' tab
       Application.Calculate
       Set ws = Worksheets.Add                               'add new sheet
       ws.Name = Worksheets("Investor Model").Range("D3")    'renames new sheet after selected asset
    If r.Font.Color = RGB(0, 153, 0) Then
        r.Copy
        Range("A1").PasteSpecial xlPasteValues
        Range("A1").Font.Color = RGB(0, 153, 0)
    Else
        r.Copy
        Range("A1").PasteSpecial xlPasteFormulas
        Range("A1").Font.Color = RGB(0, 0, 255)
    End If
       Worksheets("Investor Model").Cells.Copy
       ws.Range("A1").PasteSpecial xlFormulas                'copy values only from Investor Model to new sheet
       ws.Range("A1").PasteSpecial xlFormats                 'copy formats only from Investor Model to new sheet
       ActiveWindow.DisplayGridlines = False                 'turns off gridlines

End If
Next r

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

回答1:

To do this with colors you want to access the Font.ColorIndex property.

You will need to figure out what Color Index # relates to whatever shade of Green is being used on your sheet as well as whatever shade of Blue you want to use and sub them in the code below

Pseudo code:

For Each R in xRange
    If Len(R) > 0 Then
        If R.Font.Color = [Green Font Index #] Then
            R.Copy
            Range("?").PasteSpecial xlPasteValues
            Range("?").Font.Color = [Blue Font Index #]
        Else
            R.Copy
            Range("?").PasteSpecial xlPasteFormulas
            Range("?").Font.Color = [What color do you want here?]
        End If
    End If
Next R

I would personally prefer to not use colors as the logic driver here. If there is some logic that exists on the sheet that determines what colors the cells fonts are pre-macro (something like conditional formatting), you may be better off recreating that logic here

来源：https://stackoverflow.com/questions/59971645/how-to-code-vba-to-paste-values-or-formulas-based-on-font-color

标签

excel

vba

fonts

colors