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

jackie21

New Member
Joined
Jul 14, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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!


VBA Code:
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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,988
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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:
VBA Code:
    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.
 
Solution

jackie21

New Member
Joined
Jul 14, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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!
 

Forum statistics

Threads
1,175,794
Messages
5,899,535
Members
434,780
Latest member
andreeajc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top