Save cells to another sheet

[Paul Bergholtz]

Hi all,
I'm in the process of doing an Excel-file for measuring pressure-transmitters (se attached file).
In the dropdown-menu "Givare" I'll get the basic values from a sheet ("Data") using LOOKUP()-formula. In the cells (within the redframes) I type the values from my calibration.
Now. Here's the question:
When I press the "Save Data"-button, I would like to save the cells (within the red frames), todays date and a unique numbervalue on a different sheet("StoredData"). This new data should not be allowed to overwrite previous stored data. Any new data should be stored after the previous one on the sheet ("StoredData"). Is this doable?

Best regards,

//Paul

 

[PCosta87]

Hi Paul

Yes, you can have a VBA macro save cell contents to new sheet immediately after the source sheet (or anywhere else).

Can you provide a sample file with an example of the source data and the desired output?
It is easier to write the code that way.

Thanks

 

[Paul Bergholtz]

Hi PCosta,
I'll do it this afternoon (doesn't have the file available right now), but it's not that much code yet, only the LOOKUP()-function, but I'll upload the file later.

Thanks,

//Paul

 

[Paul Bergholtz]

Ok. So here,s the file.

Regards,

//Paul

 

[PCosta87]

Ok. So here,s the file.

Regards,

//Paul

Hi Paul

This should do it:

Sub savedata()

    Dim Source, Destination As Worksheet
    Dim lrow As Integer
    Dim i As String
 
    Set Source = Sheets("Mätdata")
    Set Destination = Sheets("StoredData")
    lrow = Destination.Columns("A").Cells(Rows.Count).End(xlUp).Row + 2
 
    Randomize
    random_number = Int(10000 * Rnd) + 1
    i = Int(CDbl(Date)) & random_number
 
    With Destination
        .Range("A" & lrow).Value = Date
        .Range("B" & lrow).Value = i
    End With
 
    Source.Range("I17:I22").Copy
    Destination.Activate
    With Destination.Range("A" & lrow + 1)
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
 
    Source.Range("Q17:Q22").Copy
    Destination.Activate
    With Destination.Range("B" & lrow + 1)
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
 
    Source.Range("S17:S22").Copy
    Destination.Activate
    With Destination.Range("C" & lrow + 1)
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
 
    Destination.Columns.AutoFit
    Destination.Range("A" & lrow).Activate

End Sub

Please refer to attachment

Let me know if this works for you

 

[Paul Bergholtz]

Hi PCosta,
Just perfect! This is just what I wanted. This gives me a platform to build on.
Thanks a lot and have a nice weekend!

Regards,

//Paul

 

[PCosta87]

Hi PCosta,
Just perfect! This is just what I wanted. This gives me a platform to build on.
Thanks a lot and have a nice weekend!

Regards,

//Paul

Don't mention it... glad I could help

Have a nice weekend