VBA: copy formula while cells in other Sheet not empty

Question

I am trying to create a sheet where the formulas are copied downwards based on non Empty Cells in Column B.

I have two Sheets in my Excel. For the first I have already written a code to copy all formulas as long as there is Data in Column B.

Sub Copy_Formula()
Dim rng As Range

Range("D9:S" & Rows.Count).Clear

Set rng = Range("B8").End(xlDown) 
Range(Cells(8, 4), Cells(8, 18)).Copy Destination:=Range(Cells(9, 4), Cells(rng.Row, 18))

    With Range(Cells(9, 4), Cells(rng.Row, 18))
        .Copy
        .PasteSpecial xlPasteAll
    End With
    Application.CutCopyMode = False

I want to perform the similar operation in Sheet2 for cells b5:d5 as long as there are non empty cells in Column B of Sheet1.

So e.g. if I have filled B8:B578 in Sheet1, the formulas in Sheet2 B5:D5 are copied down 570 times. But I am failing to code the range reference for the different sheets.

This would be a simplified example:

Sheet 1

Sheet 2 before macro

Sheet 2 after macro

So as you can see the cells B5:D5 in Sheet2 were copy and pasted 3 times

To make your question clear, I suggest you show sample data before and after the result you want. Also, define what you mean by "I am failing to code the range reference for the different sheets" — Tony M

David García Bodego David García Bodego · Accepted Answer · 2019-10-17T09:50:38

Try this one:

Sub Copy_Formula()
rng As long

Range("D9:S" & Rows.Count).Clear

rng = Range("B8").End(xlDown).Row

Range(Cells(8, 4), Cells(8, 18)).Copy Destination:=Range(Cells(9, 4), Cells(rng, 18))
With Range(Cells(9, 4), Cells(rng, 18))
    .Copy
    .PasteSpecial xlPasteAll
End With

Worksheets("Sheet2").Range(Cells(5, 2), Cells(5, 4)).Copy Destination:=Range(Cells(6, 2), Cells(rng - 8 + 5, 4))
With Worksheets("Sheet2").Range(Cells(6, 2), Cells(rng - 8 + 5, 4))
    .Copy
    .PasteSpecial xlPasteAll
End With

Application.CutCopyMode = False

...

It is what I am understanding from your description... that you already have one line formulated (B5:D5), so it is just a matter to copy this line as it is down the line. I am just keeping your philosophy., the code should be cleaner... so you will not get lost when you are working on between different sheets on a workbook.

Sub Copy_Formula()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lng As Long

With ThisWorkbook
    Set ws1 = .Worksheets("Sheet1")
    Set ws2 = .Worksheets("Sheet2")
End With

lng = ws1.Range("B8").End(xlDown).Row

ws1.Range("D9:S" & Rows.Count).Clear

ws1.Range("D8:R8").Copy Destination:=ws1.Range(Cells(9, 4), Cells(lng, 4))
With ws1.Range(Cells(9, 4), Cells(lng, 18))
    .Copy
    .PasteSpecial xlPasteAll
End With

ws2.Range("B5:D5").Copy Destination:=ws2.Range(Cells(6, 2), Cells(lng - 8 + 5, 2))
With ws2.Range(Cells(6, 2), Cells(lng - 8 + 5, 4))
    .Copy
    .PasteSpecial xlPasteAll
End With

Application.CutCopyMode = False

...

Hope it helps

VBA: copy formula while cells in other Sheet not empty

1 Answers