Copy formula value to next blank cell in a column

[keithdrone]

I've looked through the forum and found similar solutions, but I'm still wrapping my mind around VBA and don't know enough to get them to work. If there is already a thread that solves this for me I apologize.

I want to create a vba or macro that will copy the calculated formula values to the next blank cell/row of the same sheet (WrkCalc5). I've tried to perform a paste special command, but it doesn't copy the values. I'm using Excel 2003


Copy the values from these > A2, C2, D2, E2, F2, G2
to the next blank cells in their column, A3, C3, etc. Then again for A4,.... you get the idea.


I have 5 sheets in my workbook that I will create this for. Would I add a button in my spreadsheet to initialize this command on each sheet once it's ready?

Thank you in advance for your help.

[Simon Lloyd]

The following macro will copy the Summed values from the last row to the next blank row, so this assumes that the last used row on your sheet has the totals to be copied

Sub Static_totals()
Dim Rng As Range, lRow As Long
lRow = Range("G" & Rows.Count).End(xlUp).Row
  Set Rng = Range("A" & lRow & ":G" & lRow)
    Rng.Offset(1, 0) = Rng.Value
End Sub

Google Me
Find me located here Simon Lloyd and what i'm about Here
The above is NOT a link to a forum so is NOT against Rule 13

[keithdrone]

The following macro will copy the Summed values from the last row to the next blank row, so this assumes that the last used row on your sheet has the totals to be copied

Sub Static_totals()
Dim Rng As Range, lRow As Long
lRow = Range("G" & Rows.Count).End(xlUp).Row
  Set Rng = Range("A" & lRow & ":G" & lRow)
    Rng.Offset(1, 0) = Rng.Value
End Sub

That does the special paste for the values, thanks, but doesn't copy the right cells. Is it possible to modify this to copy the field from the same cell to the next blank cell, that's what I'm originally trying to do. The cells "A2, C2, D2, E2, F2, G2" are calculated every month, and I want those to be copied to the next empty row. So the values from "A2, C2, D2, E2, F2, G2" would be copied the first time to these empty cells, "A3, C3, D3, E3, F3, G3". Then, the original cells are recalculated, and those values are put into the next available ones which would be "A4, C4, D4, E4, F4, G4". I've tried modifying that VB script but I'm afraid I'm not making any headway

Thanks again!

[Simon Lloyd]

Not tested but this should do it

Sub Static_totals()
Dim Rng As Range, lRow As Long
lRow = Range("G" & Rows.Count).End(xlUp).Row
  Set Rng = Range("A" & lRow & ",D" & lrow & ":G" & lRow)
    Rng.Offset(1, 0) = Rng.Value
End Sub

Google Me
Find me located here Simon Lloyd and what i'm about Here
The above is NOT a link to a forum so is NOT against Rule 13

[kvsrinivasamurthy]

In cells A2 to G2 are you putting calculated values or formulas.Give details how you calculate values for these cells.

[keithdrone]

In cells A2 to G2 are you putting calculated values or formulas.Give details how you calculate values for these cells.

Row 4 contains the fields calculated. Every month I drop in the data, it calculates it, and I want it to move the values (not the formulas) to the next row, as you can see from the months on the far right side.


Attachment 145833

[Simon Lloyd]

Did you try my revised code?


Google Me
Find me located here Simon Lloyd and what i'm about Here
The above is NOT a link to a forum so is NOT against Rule 13

[keithdrone]

Did you try my revised code?

Yes, for whatever reason it didn't work. Perhaps because I said the wrong rows in my initial post? What would I change to copy from row 4 each time? Thanks again!

[Simon Lloyd]

Does this do what you want?

Sub Static_totals()
Dim lRow As Long
Range("A4:G4").Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
lRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A" & lRow & ":G" & lRow).Value = Range("A" & lRow & ":G" & lRow).Value
Range("B" & lRow).ClearContents
End Sub

Google Me
Find me located here Simon Lloyd and what i'm about Here
The above is NOT a link to a forum so is NOT against Rule 13

[keithdrone]

Does this do what you want?

Sub Static_totals()
Dim lRow As Long
Range("A4:G4").Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
lRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A" & lRow & ":G" & lRow).Value = Range("A" & lRow & ":G" & lRow).Value
Range("B" & lRow).ClearContents
End Sub

Google Me
Find me located here Simon Lloyd and what i'm about Here
The above is NOT a link to a forum so is NOT against Rule 13

It copies it the first few times, then starts decreasing the values that it's pasting. For example, if A4 calculates a "4", then it pastes "4" until A6, then it pastes 3 for a few rows, then 2, then 1, then 0. When I tested this I did not change the values or data in the originating rows.

[Simon Lloyd]

your attachment seems invalid or i'd test it on your data, can you posst another attachment?

[keithdrone]

I found the answer on another website, thank you all for your input but this has solved my issue below. Thank you again!


Sub Copy_external()
Dim SourceRange As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'fill in the Source Sheet and range
Set SourceRange = Sheets("external data").Range("A4:g4")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("external data")
Lr = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row


'With the information from the LastRow function we can create a
'destination cell
Set DestRange = DestSheet.Range("A" & Lr + 1)

'We make DestRange the same size as SourceRange and use the Value
'property to give DestRange the same values
With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub