Copy formulas from row above...
 

Hi,

I have some code assigned to a button that copies data from one work
sheet to the first blank cells in certain columns in a second
worksheet.

What I now want to do is fill the remainder of this "new" row with the
formulas from the row above for columns G to M.

Anyone have any ideas how to do this.

Many thanks
Simon

Code for copying the data:

Private Sub Copy_Data_Click()

Dim rng As Range, cell As Range
On Error Resume Next
With Worksheets("Data")
Set rng = .Columns(5).SpecialCells(xlBlanks)
End With
On Error GoTo 0
If rng Is Nothing Then Exit Sub
For Each cell In rng
If Application.CountA(cell.Resize(3, 1)) = 0 Then
Worksheets("Welcome").Range("C20").Copy _
Destination:=cell
Exit For
End If
Next

With Worksheets("Data")
Set rng = .Columns(6).SpecialCells(xlBlanks)
End With
On Error GoTo 0
If rng Is Nothing Then Exit Sub
For Each cell In rng
If Application.CountA(cell.Resize(3, 1)) = 0 Then
Worksheets("Welcome").Range("C22").Copy _
Destination:=cell
Exit For
End If
Next

End Sub

Copy formulas from row above...
 

Sub MyCopy()
Dim Myrow As Integer 'your found open row
Myrow = ActiveCell.Row
Application.CutCopyMode = False
Range("G" & Myrow).Offset(-1, 0).Resize(1, 7).Copy
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub


wrote:
Hi,

I have some code assigned to a button that copies data from one work
sheet to the first blank cells in certain columns in a second
worksheet.

What I now want to do is fill the remainder of this "new" row with the
formulas from the row above for columns G to M.

Anyone have any ideas how to do this.

Many thanks
Simon

Code for copying the data:

Private Sub Copy_Data_Click()

Dim rng As Range, cell As Range
On Error Resume Next
With Worksheets("Data")
Set rng = .Columns(5).SpecialCells(xlBlanks)
End With
On Error GoTo 0
If rng Is Nothing Then Exit Sub
For Each cell In rng
If Application.CountA(cell.Resize(3, 1)) = 0 Then
Worksheets("Welcome").Range("C20").Copy _
Destination:=cell
Exit For
End If
Next

With Worksheets("Data")
Set rng = .Columns(6).SpecialCells(xlBlanks)
End With
On Error GoTo 0
If rng Is Nothing Then Exit Sub
For Each cell In rng
If Application.CountA(cell.Resize(3, 1)) = 0 Then
Worksheets("Welcome").Range("C22").Copy _
Destination:=cell
Exit For
End If
Next

End Sub