Copying Excel source theme (formatting only) in VBA - vba

Question

I'm trying to programmatically copy a large range of cells from one workbook to another in VBA. I want to copy the formatting (including the entire source theme) and values, but NOT formulas. The following is my VBA code:
fromCells.Copy
toCells.PasteSpecial Paste:=xlPasteFormats
toCells.PasteSpecial Paste:=xlPasteColumnWidths
toCells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Unfortunately, there are occasions when the above code doesn't work. This is usually with Font face and size. I noticed that whenever this happens, the only way to copy the font formatting across is to use xlPasteAllUsingSourceTheme, so it seems the font formatting is somehow registered to a 'source theme'. Unfortunately, xlPasteAllUsingSourceTheme doesn't work for me because it's copying formulas as well.
So is there a way to copy the source theme (formatting only) across? Or maybe a way to force copy all the font formatting across?
Note: Copying using xlPasteAllUsingSourceTheme and then overwriting it with xlPasteValues won't work for me because when the formulas is copied it keeps popping up message boxes telling me about issues with the formulas (such as conflicting named ranges used in the formulas, etc.).
I'm using Excel 2013. I noticed this problem doesn't seem to arise in Excel 2007 or earlier. Any help is appreciated.
Edit: I've also tried the following code (added to the beginning of the above code), it still doesn't work...
Dim themeTempFilePath As String
themeTempFilePath = Environ("temp") & "\" & fromWorkbook.Name & "Theme.xml"
fromWorkbook.Theme.ThemeFontScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeFontScheme.Load themeTempFilePath
fromWorkbook.Theme.ThemeColorScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeColorScheme.Load themeTempFilePath
Update: It seems the above code for saving and loading themes does work. The problematic text that I was looking at came from a different place - a form control. It was copied as a picture (using Shape.CopyPicture) but somehow the font gets changed in the process. However, I'll post this issue as another question.
For this question, I'll put up the theme saving and loading mechanism as an answer.

Answer 1

Try 1 or 2
Option Explicit
Public Sub copyWithoutFormulas_1()
xlEnabled False
With Sheet2
.EnableCalculation = False
.EnableFormatConditionsCalculation = False
.UsedRange.EntireColumn.Delete
Sheet1.UsedRange.Copy .Cells(1, 1)
.UsedRange.Value2 = .UsedRange.Value2
.EnableCalculation = True
.EnableFormatConditionsCalculation = True
End With
Application.CutCopyMode = False
xlEnabled True
End Sub
Public Sub copyWithoutFormulas_2()
xlEnabled False
Sheet1.Copy After:=Worksheets(Worksheets.Count)
With Worksheets(Worksheets.Count).UsedRange
.Value2 = .Value2
End With
xlEnabled True
End Sub
Private Sub xlEnabled(ByVal opt As Boolean)
With Application
.EnableEvents = opt
.DisplayAlerts = opt
.ScreenUpdating = opt
.Calculation = IIf(opt, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub

Answer 2

To force copy the source theme to the destination cells, one can do the following. Unfortunately, this method will apply the source theme to the entire destination workbook, which is OK in my situation. Not sure if it's useful for anyone else.
Sub CopyText(fromCells As Range, toCells As Range, Optional copyTheme As Boolean = False)
If copyTheme Then
Dim fromWorkbook As Workbook
Dim toWorkbook As Workbook
Dim themeTempFilePath As String
Set fromWorkbook = fromCells.Worksheet.Parent
Set toWorkbook = toCells.Worksheet.Parent
themeTempFilePath = Environ("temp") & "\" & fromWorkbook.Name & "Theme.xml"
fromWorkbook.Theme.ThemeFontScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeFontScheme.Load themeTempFilePath
fromWorkbook.Theme.ThemeColorScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeColorScheme.Load themeTempFilePath
End If
Set toCells = toCells.Cells(1, 1).Resize(fromCells.Rows.Count, fromCells.Columns.Count)
fromCells.Copy
toCells.PasteSpecial Paste:=xlPasteFormats
toCells.PasteSpecial Paste:=xlPasteColumnWidths
toCells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End Sub