Search code examples
excelvbacopy-paste

Macro to copies value of a cell to another sheet but retain destination Format


I have a Sheet named "Daily Data" and One Sheet named "JPY Dly". I created a button and wrote a Macro to import data from another file and place into cells A1:D1 in "Daily Data".
enter image description here

I then need to Copy and Paste those VALUES into the next available cells in specific columns of Sheet "JPY Dly".

enter image description here

I used Offset in the Paste portion of the code but when the Paste occurs, the data does not keep the destination cells formatting. All I want is the VALUES of the cells in "Daily Data" to be copied over and for them to assume the pre-determined formatting of cells in "JPY Dly".

Here is the code that I am using.

Sub Import_DailyData()

Workbooks.Open "C:\Users\dbrown1\Downloads\exchange.csv"
'Opens the dowloaded file from the web

Workbooks("exchange.csv").Worksheets("exchange").Range("A8:AN9").Copy _
    Workbooks("FOREX TEST.xlsm").Worksheets("Daily Data").Range("A1")
'Copies the daily data into FOREX Workbook

Workbooks("exchange.csv").Close SaveChanges:=False
'Closes the downloaded sheet without saving

Kill ("C:\Users\dbrown1\Downloads\exchange.csv")

'Insert the "Write to sheets" portion of the Sub in here

Worksheets("Daily Data").Range("A2").Copy Sheets("JPY Dly").Range("C2000").End(xlUp).Offset(1, 0)
Worksheets("Daily Data").Range("F2").Copy Sheets("JPY Dly").Range("E2000").End(xlUp).Offset(1, 0)
Worksheets("Daily Data").Range("G2").Copy Sheets("JPY Dly").Range("F2000").End(xlUp).Offset(1, 0)
Worksheets("Daily Data").Range("E2").Copy Sheets("JPY Dly").Range("G2000").End(xlUp).Offset(1, 0)

'Below this you will see the ClearContents portion of the code
Worksheets("Daily Data").Range("A1:AN2").ClearContents


End Sub

Can you please tell me how to paste the Values only from "Daily Data" and them assume the formatting of the cells in "JPY Dly"?

UPDATE Here is updated code recommended by chrisnielsen and the screenshot from the downloaded "exchange"file.

Sub Import_DailyData()

    Dim wbCSV As Workbook
    Dim wsCSV As Worksheet
    Dim wsDestination As Worksheet
    Dim DestRow As Long

Set wbCSV = Workbooks.Open("C:\Users\dbrown1\Downloads\exchange.csv")
Set wsCSV = wbCSV.Worksheets("exchange")
'Opens the dowloaded file from the web

Set wsDestination = ThisWorkbook.Worksheets("JPY Dly")
'Copies the daily data into FOREX Workbook


'Closes the downloaded sheet without saving

'Insert the "Write to sheets" portion of the Sub in here

With wsDestination
        DestRow = .Cells(.Rows.Count, 3).End(xlUp) + 1
    
        ' Copy data
        .Cells(DestRow, 3).Value = wsCSV.Cells(2, 1).Value
        .Cells(DestRow, 5).Value = wsCSV.Cells(2, 3).Value
        .Cells(DestRow, 6).Value = wsCSV.Cells(2, 4).Value
        .Cells(DestRow, 7).Value = wsCSV.Cells(2, 2).Value
End With
'Below this you will see the ClearContents portion of the code
'Worksheets("Daily Data").Range("A1:AN2").ClearContents
Workbooks("exchange.csv").Close SaveChanges:=False
'Kill ("C:\Users\dbrown1\Downloads\exchange.csv")

End Sub

enter image description here


Solution

  • While Copy/Paste Values will work, it's cleaner to use the values properties of the source and destination cells. This will retain destination cell formats.

    Also, there are a number of other opertunities for improvement

    1. Use Workbook and Workssheet references
    2. No need for the intermediate Daily Data Sheet.
    3. No need to repeat the .End(xlUp) bits
    4. No need for the ( ) on the Kill line (in fact this has side effects that, while not a problem here, will eventually bite you)
    Sub Import_DailyData()
        Dim wbCSV As Workbook
        Dim wsCSV As Worksheet
        Dim wsDestination As Worksheet
        Dim DestRow As Long
        
        'Open the dowloaded file from the web, and get references
        Set wbCSV = Workbooks.Open("C:\Users\dbrown1\Downloads\exchange.csv")
        Set wsCSV = wbCSV.Worksheets("exchange")
        
        ' Reference the destination
        Set wsDestination = ThisWorkbook.Worksheets("JPY Dly") ' Assuming FOREX TEST.xlsm contains this code
        ' If FOREX TEST.xlsm does not contains this code, use this instead of the previous line
        'Set wsDestination = Application.Workbooks("FOREX TEST.xlsm").Worksheets("JPY Dly")
        
        ' get destination row
        With wsDestination
            DestRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
        
            ' Copy data
            .Cells(DestRow, 3).Value = wsCSV.Cells(2, 1).Value
            .Cells(DestRow, 5).Value = wsCSV.Cells(2, 6).Value
            .Cells(DestRow, 6).Value = wsCSV.Cells(2, 7).Value
            .Cells(DestRow, 7).Value = wsCSV.Cells(2, 5).Value
        End With
        
        'Close and delete the downloaded workbook without saving
        wbCSV.Close SaveChanges:=False
        Kill "C:\Users\dbrown1\Downloads\exchange.csv"
        
    End Sub