How to GetOpenFilename application to copy over text color from source file to target file.

[scbybee]

I'm using GetOpenFilename to load a source file date to my target file - and it works, but I want to bring over some formatting also (in this case, text color).

My source cells have any of four font colors, but I'm passing only the cell Value (line in blue below in sample code), so it's only showing up in the target file as black font.

Is there a Range property or method that will also pass along the cell's format?

Code:
Private Sub CommandButton3_Click()
Dim sourceBook As Workbook
Dim filter As String
Dim caption As String
Dim sourceFilename As String
Dim sourceWorkbook As Workbook
Dim targetWorkbook As Workbook

Set targetWorkbook = Application.ActiveWorkbook

' get the source workbook
filter = "Excel files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
sourceFilename = Application.GetOpenFilename(filter, , caption)

Set sourceWorkbook = Application.Workbooks.Open(sourceFilename)

' copy data from source to target workbook
Dim targetSheet As Worksheet
Dim sourceSheet As Worksheet

Set targetSheet = targetWorkbook.Worksheets(1)
Set sourceSheet = sourceWorkbook.Worksheets(1)

targetSheet.Range("B6", "D45").Value = sourceSheet.Range("A2", "C45").Value

' Close source workbook
sourceWorkbook.Close
End Sub

 

[DanteAmor]

Try this

[I]Private Sub CommandButton3_Click()
[I]Dim sourceBook As Workbook
[I]Dim filter As String
[I]Dim caption As String
[I]Dim sourceFilename As String
[I]Dim sourceWorkbook As Workbook
[I]Dim targetWorkbook As Workbook

[I]Set targetWorkbook = Application.ActiveWorkbook

[I]' get the source workbook
[I]filter = "Excel files (*.xlsx),*.xlsx"
[I]caption = "Please Select an input file "
[I]sourceFilename = Application.GetOpenFilename(filter, , caption)

[I]Set sourceWorkbook = Application.Workbooks.Open(sourceFilename)

[I]' copy data from source to target workbook
[I]Dim targetSheet As Worksheet
[I]Dim sourceSheet As Worksheet

[I]Set targetSheet = targetWorkbook.Worksheets(1)
[I]Set sourceSheet = sourceWorkbook.Worksheets(1)

[COLOR=#0000ff][I]targetSheet.Range("B6", "D45").Value = sourceSheet.Range("A2", "C45").Value[/I][/COLOR]
[/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][COLOR=#ff0000]sourceSheet.Range("A2").Copy[/COLOR]
[COLOR=#ff0000]targetSheet.Range("B6").PasteSpecial xlPasteFormats[/COLOR]
[COLOR=#ff0000]sourceSheet.Range("C45").Copy[/COLOR]
[COLOR=#ff0000]targetSheet.Range("D45").PasteSpecial xlPasteFormats[/COLOR]


[I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I]
[I]' Close source workbook
[I]sourceWorkbook.Close
[I]End Sub[/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I]

 

[scbybee]

Try this

[I]Private Sub CommandButton3_Click()
[I]Dim sourceBook As Workbook
[I]Dim filter As String
[I]Dim caption As String
[I]Dim sourceFilename As String
[I]Dim sourceWorkbook As Workbook
[I]Dim targetWorkbook As Workbook

[I]Set targetWorkbook = Application.ActiveWorkbook

[I]' get the source workbook
[I]filter = "Excel files (*.xlsx),*.xlsx"
[I]caption = "Please Select an input file "
[I]sourceFilename = Application.GetOpenFilename(filter, , caption)

[I]Set sourceWorkbook = Application.Workbooks.Open(sourceFilename)

[I]' copy data from source to target workbook
[I]Dim targetSheet As Worksheet
[I]Dim sourceSheet As Worksheet

[I]Set targetSheet = targetWorkbook.Worksheets(1)
[I]Set sourceSheet = sourceWorkbook.Worksheets(1)

[COLOR=#0000ff][I]targetSheet.Range("B6", "D45").Value = sourceSheet.Range("A2", "C45").Value[/I][/COLOR]
[/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][COLOR=#ff0000]sourceSheet.Range("A2").Copy[/COLOR]
[COLOR=#ff0000]targetSheet.Range("B6").PasteSpecial xlPasteFormats[/COLOR]
[COLOR=#ff0000]sourceSheet.Range("C45").Copy[/COLOR]
[COLOR=#ff0000]targetSheet.Range("D45").PasteSpecial xlPasteFormats[/COLOR]


[I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I][I]
[I]' Close source workbook
[I]sourceWorkbook.Close
[I]End Sub[/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I][/I]

That worked great! Thanks. I didn't think about multi-steps. I figured I had to do it all in one command.
I had to change the range assignment. For some reason it doesn't want ":" but instead wants ",".

targetSheet.Range("B6", "D45").Value = sourceSheet.Range("A2", "C45").Value
sourceSheet.Range("A2", "C45").Copy
targetSheet.Range("B6", "D45").PasteSpecial xlPasteFormats
'sourceSheet.Range("C45").Copy
'targetSheet.Range("D45").PasteSpecial xlPasteFormats


Now I have an unexpected nuisance.
Just copying value didn't get me this, but with copying over the formats I get the Excel warning message
"There is a large amount of information on the Clipboard. Do you want to be able to paste this information into another program later?.....
when it tries to close the workbook.

 

[DanteAmor]

Below this line

[I]Dim targetWorkbook As Workbook[/I]

add this lines

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

 

[scbybee]

Works perfectly!
Many-many thanks Dante.
It was time to head home from work yesterday, and this morning I had this sitting on my desk.
It's going to be a great day.

Cheers and Thanks again.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.