Thread: Copy formula - Tom Ogilvy

Sub CopyFormulas()
Dim rng1 as Range, rng2 as Range, i as Long
on Error Resume Next
set rng1 = Application.InputBox("Select cells to copy using
mouse",type:=8)
On Error goto 0
if rng1 is nothing then
msgbox "You selected nothing"
exit sub
end if

on Error Resume Next
set rng2 = Application.InputBox("Select top cell to paste tousing
mouse",type:=8)
On Error goto 0
if rng2 is nothing then
msgbox "You selected nothing"
exit sub
end if

i = 1
for each cell in rng1
rng2(i).Formula = cell.formula
i = i + 1
Next

End Sub


Coulp Tom or someone else make the above formula work for both a
vertical & horizontal range.As it's now pasting range vertically even
if a horizontal range has been copied.

Thxs a lot

Replace

i = 1
for each cell in rng1
rng2(i).Formula = cell.formula
i = i + 1
Next

with

i = 1
For Each cell In rng1
If rng1.Columns.Count = 1 Then
rng2(i).Formula = cell.Formula
Else
rng2(, i).Formula = cell.Formula
End If
i = i + 1
Next


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com



"al007" <transferxxx@gmail.com> wrote in message
news:1139611887.723205.23620@g43g2000cwa.googlegroups.com...
> Sub CopyFormulas()
> Dim rng1 as Range, rng2 as Range, i as Long
> on Error Resume Next
> set rng1 = Application.InputBox("Select cells to copy using
> mouse",type:=8)
> On Error goto 0
> if rng1 is nothing then
> msgbox "You selected nothing"
> exit sub
> end if
>
> on Error Resume Next
> set rng2 = Application.InputBox("Select top cell to paste
> tousing
> mouse",type:=8)
> On Error goto 0
> if rng2 is nothing then
> msgbox "You selected nothing"
> exit sub
> end if
>
> i = 1
> for each cell in rng1
> rng2(i).Formula = cell.formula
> i = i + 1
> Next
>
> End Sub
>
>
> Coulp Tom or someone else make the above formula work for both
> a
> vertical & horizontal range.As it's now pasting range
> vertically even
> if a horizontal range has been copied.
>
> Thxs a lot
>

Chip,
Thxs a lot ! - am a great fan of yours as I've been learning a lot from
your site.
Pls keep adding new tips




Chip Pearson wrote:
> Replace
>
> i = 1
> for each cell in rng1
> rng2(i).Formula = cell.formula
> i = i + 1
> Next
>
> with
>
> i = 1
> For Each cell In rng1
> If rng1.Columns.Count = 1 Then
> rng2(i).Formula = cell.Formula
> Else
> rng2(, i).Formula = cell.Formula
> End If
> i = i + 1
> Next
>
>
> --
> Cordially,
> Chip Pearson
> Microsoft MVP - Excel
> Pearson Software Consulting, LLC
> www.cpearson.com
>
>
>
> "al007" <transferxxx@gmail.com> wrote in message
> news:1139611887.723205.23620@g43g2000cwa.googlegroups.com...
> > Sub CopyFormulas()
> > Dim rng1 as Range, rng2 as Range, i as Long
> > on Error Resume Next
> > set rng1 = Application.InputBox("Select cells to copy using
> > mouse",type:=8)
> > On Error goto 0
> > if rng1 is nothing then
> > msgbox "You selected nothing"
> > exit sub
> > end if
> >
> > on Error Resume Next
> > set rng2 = Application.InputBox("Select top cell to paste
> > tousing
> > mouse",type:=8)
> > On Error goto 0
> > if rng2 is nothing then
> > msgbox "You selected nothing"
> > exit sub
> > end if
> >
> > i = 1
> > for each cell in rng1
> > rng2(i).Formula = cell.formula
> > i = i + 1
> > Next
> >
> > End Sub
> >
> >
> > Coulp Tom or someone else make the above formula work for both
> > a
> > vertical & horizontal range.As it's now pasting range
> > vertically even
> > if a horizontal range has been copied.
> >
> > Thxs a lot
> >