Keep Cell Format (VBA copying and pasting from one workbook to another)

[jackie21]

Hi- I am new-ish to VBA and first code using the scripting dictionary which I am still trying to understand.
I am trying to write a code that will copy, search/match and then paste specific cells from one workbook to another workbook. The code below is mostly doing the job.
The only issue that I am having is keeping the formatting. For example, if a cell is bolded in the workbook that I am copying from, it is not bolded when it has been pasted into the other workbook.
Any help is appreciated. Thank you for taking the time!

Sub IS_to_RT()
    Dim Cl As Range
    Dim Dic As Object
    Dim Answer As VbMsgBoxResult
    
    Answer = MsgBox("Do you have the RT spreadsheet open and named:" & Chr(13) & Chr(10) & "2022 RT Report", vbYesNo + vbQuestion, "Ready to update the RT Report?")
    If Answer = vbYes Then
 
     ' Fill in column Manager
    Set Dic = CreateObject("scripting.dictionary")
    With Workbooks("IT Workplan.xlsm").Sheets("2022")
        For Each Cl In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Cl.Offset(, -1).Value
        Next Cl
    End With
      
    With Workbooks("2022 RT Report.xlsx").Sheets("RT Report")
        For Each Cl In .Range("M4", .Range("M" & Rows.Count).End(xlUp))
            If Dic.exists(Cl.Value) Then Cl.Offset(, -9).Value = Dic(Cl.Value)
        Next Cl
    End With
    
    ' Fill in column Current Status
    Set Dic = CreateObject("scripting.dictionary")
    With Workbooks("IT Workplan.xlsm").Sheets("2022")
        For Each Cl In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Cl.Offset(, 4).Value
        Next Cl
    End With
    
     With Workbooks("2022 RT Report.xlsx").Sheets("RT Report")
        For Each Cl In .Range("M4", .Range("M" & Rows.Count).End(xlUp))
            If Dic.exists(Cl.Value) Then Cl.Offset(, 1).Value = Dic(Cl.Value)
        Next Cl
    End With
    
     MsgBox "RT Report has been updated", vbOKOnly, "Finished"
    
Else

MsgBox "No changes made." & Chr(13) & Chr(10) & "If you wish to update the RT Report spreadsheet, please ensure it is open and named:" & Chr(13) & Chr(10) & "2022 RT Report", vbOKOnly + vbInformation, "Attention"

Exit Sub
End If
    
End Sub

 

[Anthony47]

Two examples:

With Workbooks("IT Workplan.xlsm").Sheets("2022")
For Each Cl In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
Dic(Cl.Value) = Cl.Row 'MMM
Next Cl
End With

With Workbooks("2022 RT Report.xlsx").Sheets("RT Report")
For Each Cl In .Range("M4", .Range("M" & Rows.Count).End(xlUp))
If Dic.exists(Cl.Value) Then 'MMM
Workbooks("IT Workplan.xlsm").Sheets("2022").Cells(Dic(Cl.Value), 2).Copy Destination:=Cl.Offset(, -9)
End If
Next Cl
End With

This version stores in the dictionary the "Row" of the elements, then in the second block you "Copy" that row and paste it into the new workbook/worksheet
The modified areas, with respect to your code, are marked MMM

OR
You could store in the dictionary more than the value of the element, for example also the Bold status and the Interior.Color; then in the second block you decode these values/status and apply them to the target cell:

    With Workbooks("IT Workplan.xlsm").Sheets("2022")
        For Each Cl In .Range("C3", .Range("C" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Cl.Row & Chr(10) & Cl.Font.Bold & Chr(10) & Cl.Interior.Color      'MMM-1
        Next Cl
    End With

    With Workbooks("2022 RT Report.xlsx").Sheets("RT Report")
        For Each Cl In .Range("M4", .Range("M" & Rows.Count).End(xlUp))
            If Dic.exists(Cl.Value) Then                                    'MMM-2
                mySplit = Split(Dic(Cl.Value) & " " & Chr(10), Chr(10), , vbTextCompare)
                If UBound(mySplit) = 3 Then           'if mySplit contains the parametres...
                    Cl.Offset(, -9).Value = mySplit(0)
                    Cl.Offset(, -9).Font.Bold = mySplit(1)
                    Cl.Offset(, -9).Interior.Color = mySplit(2)
                End If
                Workbooks("IT Workplan.xlsm").Sheets("2022").Cells(Dic(Cl.Value), 2).Copy Destination:=Cl.Offset(, -9)
            End If
        Next Cl
    End With

Of course if you need more parametres then you have to collect them in the phase 1 (line MMM-1) and then apply then in phase 2 (see MMM-2 and subsequent lines)

Test the two options, I don't know which one is the slowest (the second one, I guess); and, btw, both are much slower that the original one that deals only with the Value.

Another option you should evaluate is copying the ranges in an Array, then work using the Array values.

 

[jackie21]

Thank you, I was able to try this out today and it worked perfectly. I went with your first example.
Appreciate you sharing your VBA knowledge!