VBA Code to copy values &formats to the next worksheet

[bobby]

Hi everybody,

I need a VBA code to copy the values in one sheet to the other
sheet. Here I'm giving my actual problem.

I have data in columns A to M which is generated by some conditional
formulas, if the condition is satisfied it will generate real values in
the cells if the condition is unsatisfied then the cell will display
"FALSE". Now what I need is a macro that copies only the cells which
are having values and paste to the other sheet spcecified and also I
need to copy column A to Column A ...So on, but I wnat to skip some
columns like E&H.

I got a macro in this group which copy and paste values&Formats to the
other sheet by selecting the range manually and then pasting the values
at the destination by running the macro.

The macro is like this.

Sub Pastesp()
with selection
pastespecial xlvalues
pastespecial xlformats
cutcopymode=false.
end sub.

can any body helpme to expand this code so that I can apply for my
specific problem.

Thanks and Regards

Ramana

 

[Tom Ogilvy]

Dim rng as Range, cell as Range, cell1 as Range
set rng = Activesheet.UsedRange.SpecialCells(xlFormulas,xlNumbers)
for each cell in rng
if cell.column <> 5 and cell.column <> 8 then
set cell1 = Worksheets("Sheet2").Range(cell.Address)
cell.copy
cell1.PasteSpecial xlValues
cell1.PasteSpecial xlFormats
end if
Next

 

[MSama]

Hello Tom,

I have used portions of this example for my own little project. How
can I get rid of the animated dotted box around the range selected to
COPY after the pastespecial?

Thanks!

 

[MSama]

I think I have it. I got the idea from another entry in this group,
that if i record a macro with the action I want to automate, I can then
look at the code that was generated - brilliant!

Thanks anyway!

-Marco

 

[Dave Peterson]

Add:

Application.cutcopymode = false

right before the "end sub" line

 

[Tom Ogilvy]

After the paste, do

Application.CutCopyMode = False

 

[bobby]

Hi Tom Ogilvy,

The VBA code you have given is working partially and didn't solve
my problem. It is copying the values and formats but not satisfying the
conditions.
My format is like this.
In colun A&B i genrate random numbers so that the sum of the two
columns will be in a specified range. column E&F I generate agan randon
numbers so that the sum of the both columns with in a specified range.
Then in column D I apply the formula 100-C-G. The macro is copying the
values but the sum when I do i.e. (C+D+G) is not equal to 100. It
should equal to 100 satisfying my conditions in the sheet1.
If you could help me to get this it would be a great help for me.

thanks for the effort put by you & PY&Associates. but unfortyunately
the PY&associates code giving a run time error.

Thanks and Regards

Ramana

 

[Tom Ogilvy]

Dim rng as Range, cell as Range, cell1 as Range
Dim rng2 as Range, c as Long, cell2 as Range

set rng2 = Range(.Cells(2,"D"),.Cells(2,"D").End(xldown))
c = Application.Calculation
Application.Calculation = xlManual
for each cell2 in rng2
if abs(100-cell2) < .00001 then
set rng = cell2.EntireRange.SpecialCells(xlFormulas,xlNumbers)
for each cell in rng
if cell.column <> 5 and cell.column <> 8 then
set cell1 = Worksheets("Sheet2").Range(cell.Address)
cell.copy
cell1.PasteSpecial xlValues
cell1.PasteSpecial xlFormats
end if
Next
end if
Next
Application.Calculation = c

 

[bobby]

Hi tom,

The compiler is giving code error. it is telling that .cells as
invalid reference.

in the line

setrng2 = range(.cells(2,"D"),.cells(2,"D").end(xldown))

can you look at that.

Thanks & Regards

Ramana

 

[Dave Peterson]

Dim rng as Range, cell as Range, cell1 as Range
Dim rng2 as Range, c as Long, cell2 as Range

with worksheets("sheet1") 'or whatever sheet your data is on
set rng2 = .Range(.Cells(2,"D"),.Cells(2,"D").End(xldown))
end with

c = Application.Calculation
Application.Calculation = xlManual

for each cell2 in rng2
if abs(100-cell2) < .00001 then
'typo alert next line <----
set rng = cell2.EntireRow.SpecialCells(xlFormulas,xlNumbers)
for each cell in rng
if cell.column <> 5 and cell.column <> 8 then
set cell1 = Worksheets("Sheet2").Range(cell.Address)
cell.copy
cell1.PasteSpecial xlValues
cell1.PasteSpecial xlFormats
end if
Next
end if
Next
Application.Calculation = c


(untested, but it did compile)