excel - Make formatting transfer when using two sheets with formulas to reference each other - Stack Overflow

admin管理员组

文章数量:1289394

I have two excel sheets within the same book. It's a schedule that is viewed in two different ways. I have formulas set for the second schedule to communicate with the first so that only the data we want shared is displayed, but I need formatting to cross over. Specifically strike throughs. For example, when I strike through the scheduled day for an employee on my master schedule, I need the strike through formatting to transfer to the schedule that's printed for employees. I am very familiar with formulas in communication between sheets, however, those have nothing to do with formatting. Conditional formatting doesn't seem to apply here. I started diving into VBA codes, but I'm out of my depths on this one. Help?

I have tried a few codes from other forum results, but am not getting results that I need. I need someone who is good at code to help me solve this because I clearly don't understand it yet.

This is what I used

Sub CopyCellTextFormatting() 
    Dim wsSource As Worksheet 
    Dim wsDestination As Worksheet 
    Dim cell As Range 
    Dim sourceRange As Range 
    Dim sheetName As String 
    Dim cellRef As String 
    Dim formula As String 
    ' Set source and destination worksheets 
    Set wsSource = ThisWorkbook.Sheets("FEBRUARY 2025") ' Source sheet name
    Set wsDestination = ThisWorkbook.Sheets("FEBRUARY EZ") ' Destination sheet name 

    'Loop through all cells in the destination sheet 
    For Each cell In wsDestination.UsedRange 
        ' Check if the cell has a formula referencing the source sheet 
        If InStr(cell.formula, "FEBRUARY 2025") > 0 Then 
            formula = cell.formula ' Extract the sheet name (between the single quotes and the exclamation mark) 
            sheetName = Mid(formula, InStr(formula, "'") + 1, InStrRev(formula, "'") - InStr(formula, "'") - 1) 

            ' Extract the cell reference (after the '!' symbol) 
            cellRef = Mid(formula, InStrRev(formula, "!") + 1) 
            ' Reference the range from the source sheet using the cell reference 
            Set sourceRange = wsSource.Range(cellRef) 
            ' Copy the specific font properties (without changing font size or borders) 
            With cell.Font
                .Color = sourceRange.Font.Color  'Copy font color 
                .Bold = sourceRange.Font.Bold ' Copy bold formatting 
                .Italic = sourceRange.Font.Italic ' Copy italics formatting 
                .Underline = sourceRange.Font.Underline ' Copy underline formatting 
                .Strikethrough = sourceRange.Font.Strikethrough ' Copy strikethrough formatting 
                .Name = sourceRange.Font.Name ' Copy font name (style) 
           End With 
        End If 
    Next cell
    MsgBox "Text formatting copied successfully!", vbInformation 
End Sub 

I have two excel sheets within the same book. It's a schedule that is viewed in two different ways. I have formulas set for the second schedule to communicate with the first so that only the data we want shared is displayed, but I need formatting to cross over. Specifically strike throughs. For example, when I strike through the scheduled day for an employee on my master schedule, I need the strike through formatting to transfer to the schedule that's printed for employees. I am very familiar with formulas in communication between sheets, however, those have nothing to do with formatting. Conditional formatting doesn't seem to apply here. I started diving into VBA codes, but I'm out of my depths on this one. Help?

I have tried a few codes from other forum results, but am not getting results that I need. I need someone who is good at code to help me solve this because I clearly don't understand it yet.

This is what I used

Sub CopyCellTextFormatting() 
    Dim wsSource As Worksheet 
    Dim wsDestination As Worksheet 
    Dim cell As Range 
    Dim sourceRange As Range 
    Dim sheetName As String 
    Dim cellRef As String 
    Dim formula As String 
    ' Set source and destination worksheets 
    Set wsSource = ThisWorkbook.Sheets("FEBRUARY 2025") ' Source sheet name
    Set wsDestination = ThisWorkbook.Sheets("FEBRUARY EZ") ' Destination sheet name 

    'Loop through all cells in the destination sheet 
    For Each cell In wsDestination.UsedRange 
        ' Check if the cell has a formula referencing the source sheet 
        If InStr(cell.formula, "FEBRUARY 2025") > 0 Then 
            formula = cell.formula ' Extract the sheet name (between the single quotes and the exclamation mark) 
            sheetName = Mid(formula, InStr(formula, "'") + 1, InStrRev(formula, "'") - InStr(formula, "'") - 1) 

            ' Extract the cell reference (after the '!' symbol) 
            cellRef = Mid(formula, InStrRev(formula, "!") + 1) 
            ' Reference the range from the source sheet using the cell reference 
            Set sourceRange = wsSource.Range(cellRef) 
            ' Copy the specific font properties (without changing font size or borders) 
            With cell.Font
                .Color = sourceRange.Font.Color  'Copy font color 
                .Bold = sourceRange.Font.Bold ' Copy bold formatting 
                .Italic = sourceRange.Font.Italic ' Copy italics formatting 
                .Underline = sourceRange.Font.Underline ' Copy underline formatting 
                .Strikethrough = sourceRange.Font.Strikethrough ' Copy strikethrough formatting 
                .Name = sourceRange.Font.Name ' Copy font name (style) 
           End With 
        End If 
    Next cell
    MsgBox "Text formatting copied successfully!", vbInformation 
End Sub 

• excel
• vba

Share Improve this question Follow edited Feb 20 at 21:15 CDP1802 16.4k22 gold badges1010 silver badges1818 bronze badges asked Feb 20 at 19:05 Tracy BuckholzTracy Buckholz 1111 bronze badge 9

• 1 Are your formulas a simple reference, or do they involve functions such as XLOOKUP? You'll probably need to leverage the Worksheet.Calculate event in any case. – BigBen Commented Feb 20 at 19:09
• 2 "I have tried a few codes" - helps to show an example of what you tried and explain how/why that didn't meet your needs. – Tim Williams Commented Feb 20 at 19:25
• This is an example of the formula being used. ='FEBRUARY 2025'!$BT$10 – Tracy Buckholz Commented Feb 20 at 19:55
• I got it corrected. This is what I used, split into two comments (it's too long): Sub CopyCellTextFormatting() Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim cell As Range Dim sourceRange As Range Dim sheetName As String Dim cellRef As String Dim formula As String ' Set source and destination worksheets Set wsSource = ThisWorkbook.Sheets("FEBRUARY 2025") ' Source sheet name Set wsDestination = ThisWorkbook.Sheets("FEBRUARY EZ") ' Destination sheet name – Tracy Buckholz Commented Feb 20 at 20:41
• ' Loop through all cells in the destination sheet For Each cell In wsDestination.UsedRange ' Check if the cell has a formula referencing the source sheet If InStr(cell.formula, "FEBRUARY 2025") > 0 Then formula = cell.formula ' Extract the sheet name (between the single quotes and the exclamation mark) sheetName = Mid(formula, InStr(formula, "'") + 1, InStrRev(formula, "'") - InStr(formula, "'") - 1) – Tracy Buckholz Commented Feb 20 at 20:42

 |  Show 4 more comments

1 Answer 1

Sorted by: Reset to default 1

Here's a basic example. ws is the sheet with your linking formulas. It will try to get a range src from each formula, and if it's a single-cell range then it will copy the source cell's strikethrough to the cell with the formula.

Sub CopySourceformats()
    Dim ws As Worksheet, c As Range, src As Range
    
    Set ws = ActiveSheet 'or a specific sheet
    
    For Each c In ws.UsedRange.SpecialCells(xlCellTypeFormulas).Cells
        
        Set src = Nothing
        On Error Resume Next 'ignore any error
        Set src = Range(Replace(c.Formula, "=", ""))
        On Error GoTo 0      'stop ignoring errors
        
        If Not src Is Nothing Then
            'got source cell...
            Debug.Print c.Address, "links to", src.Address(external:=True)
            If src.Cells.Count = 1 Then 'if source is a single cell then copy the strikethrough
                c.Font.Strikethrough = src.Font.Strikethrough
                'copy any other formatting....
            End If
        End If
        
    Next c
    
End Sub

This code could be triggered for example from the formula sheet's Calculate event, though likely setting a strikethrough on the source sheet may not trigger a recalculation, so I would make sure that code runs before you need to use the formula sheet for anything (eg. before printing).

本文标签： excelMake formatting transfer when using two sheets with formulas to reference each otherStack Overflow