VBA Copy & Paste last row with formula, then copy & Paste the row above as Value

[Michaelstef]

Dear Sir or Madam,
I am looking for a VBA Excel Makro with the following action:
I have an excel workbook with many sheets. They are all set-up the same way.
I need to copy&Past always the last row within a sheet with the formula and copy&Past thereafter the row above with Value within the same sheet.
Example:
C7:D7 pull formula to C8:D8
O77 pull formula to o88
r7:r7 pull formula to r8:r8
thereafter:
C7:D7 copy&past as values
O77 copy&paste as values
r7:r7 copy&paste as values
It should always automaically go to the last row and has many sheets, alls set up the same way, besides the first sheet.
Thanks in advance for your support.
Best regards

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub CopyFormulas()
   Dim ws As Worksheet
   Dim fnd As Range
   For Each ws In Worksheets
      Set fnd = ws.Cells.Find("*", , xlValues, , xlRows, xlPrevious, , , False)
      Set fnd = Intersect(ws.UsedRange, fnd.EntireRow).SpecialCells(xlFormulas)
      fnd.Resize(2).FillDown
      fnd.Value = fnd.Value
      Set fnd = Nothing
   Next ws
End Sub

 

[Michaelstef]

Hi Fluff
Thanks for your e-mail.
This formula unfortunately does not work. I have tried and found a way to copy down the last row:

Cells(Rows.Count, 3).End(xlUp).Copy
eRow = Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Cells(eRow, 3).PasteSpecial xlPasteFormulas

Now I just need to copy & paste the row above the last row. How is this VBA code?

Thanks for your feedback.

Best regards

michael

 

[Michaelstef]

Hi

I tried this:

Cells(Rows.Count, 3).End(xlUp).Copy
cRow = Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Cells(cRow, 3).PasteSpecial xlPasteFormulas
hRow = Cells(Rows.Count, 3).End(xlUp).Offset(-1, 0).Copy
Cells(hRow, 3).PasteSpecial xlPasteFormulas

But it somehow does not work. Can anyone help?

Thanks in advance for your feedback.

Best regards

 

[Michaelstef]

Sorry, it should read:

Cells(Rows.Count, 3).End(xlUp).Copy
cRow = Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Cells(cRow, 3).PasteSpecial xlPasteFormulas
hRow = Cells(Rows.Count, 3).End(xlUp).Offset(-1, 0).Copy
Cells(hRow, 3).PasteSpecial xlPasteValues

 

[Fluff]

In what way didn't the code I supplied work?

 

[Michaelstef]

In what way didn't the code I supplied work?

Nothing happened. I but in now the following formula:

Sub Copy()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
         
Cells(Rows.Count, 3).End(xlUp).Copy
aRow = Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Cells(aRow, 3).PasteSpecial xlPasteFormulas
Cells(Rows.Count, 3).End(xlUp).Offset(-1, 0).Copy
bRow = Cells(Rows.Count, 3).End(xlUp).Offset(-1, 0).Row
Cells(bRow, 3).PasteSpecial xlPasteValues
Cells(Rows.Count, 4).End(xlUp).Copy
aRow = Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
Cells(aRow, 4).PasteSpecial xlPasteFormulas
Cells(Rows.Count, 4).End(xlUp).Offset(-1, 0).Copy
bRow = Cells(Rows.Count, 4).End(xlUp).Offset(-1, 0).Row
Cells(bRow, 4).PasteSpecial xlPasteValues
Cells(Rows.Count, 15).End(xlUp).Copy
aRow = Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).Row
Cells(aRow, 15).PasteSpecial xlPasteFormulas
Cells(Rows.Count, 15).End(xlUp).Offset(-1, 0).Copy
bRow = Cells(Rows.Count, 15).End(xlUp).Offset(-1, 0).Row
Cells(bRow, 15).PasteSpecial xlPasteValues
Cells(Rows.Count, 18).End(xlUp).Copy
aRow = Cells(Rows.Count, 18).End(xlUp).Offset(1, 0).Row
Cells(aRow, 18).PasteSpecial xlPasteFormulas
Cells(Rows.Count, 18).End(xlUp).Offset(-1, 0).Copy
bRow = Cells(Rows.Count, 18).End(xlUp).Offset(-1, 0).Row
Cells(bRow, 18).PasteSpecial xlPasteValues
Next
End Sub

Is there a way to shorten this formula? This formula works now perfectly.

Thanks for your help.

Best regards