condiionaly copy to another sheet

  • Thread starter Thread starter GUS
  • Start date Start date
G

GUS

I have a sheets that look likes this

a b c d e f
1 jimm 123 3434 342 22 sum
2 john 454 sum
3 james
4 jenifer 4554
5 jimmy
6 george 4344 4334
7 jenny
8 felix 5455

some of the names hasn't values in column a,b,c,d,e like jimmy for example.
In column f i have a sum of (b,c,d,e) values


In other words i want to copy only the range that have some values in
columns b,c,d,e
and paste them in an other sheet one under the other.

I have manage to do that by creating a loop from row 1 to row .... and
checking if f1,f2... etc >0 then copy range from 1 to 5 to another sheet.

I want to know if there is a more simple method for doing this.

I want to use this macro to a balance sheet in order to tranfer to another
sheet only the lines that has values but the thing is that i want to paste
also the formation of the cells, couse some of them has borders that i want
to keep to the other sheet.
 
Sounds reasonable to me.

It sounds like you could just check what the =sum() formula evaluated to in
column F. If it were 0, then don't copy it. (But that would be a problem if
you had positive and negative values in B:E that might sum to 0.)

If your cells were really empty (not formulas that evaluate to ""), you could
use application.counta() to see if any of B:E had values in them.

That's what I did with this:

Option Explicit
Sub testme02()
Dim FromWks As Worksheet
Dim ToWks As Worksheet
Dim rngToCopy As Range
Dim destCell As Range
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Set FromWks = Worksheets("sheet1")
Set ToWks = Worksheets("sheet2")

With FromWks
FirstRow = 2 'headerrows???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
If Application.CountA(.Cells(iRow, "B").Resize(1, 4)) > 0 Then
With ToWks
Set destCell _
= .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
Set rngToCopy = .Cells(iRow, "A").Resize(1, 5) 'A to E???
destCell.Resize(rngToCopy.Rows.Count, _
rngToCopy.Columns.Count).Value _
= rngToCopy.Value
End If
Next iRow
End With

End Sub
 
Hi Gus,

think you can do it like this...

Sub test()
Dim rij As Integer
rij = Sheets("Blad2").Range("A65536").End(xlUp).Row + 1
Sheets("sheet2").Cells(row, 1) = Sheets("sheet1").Range("B1")
Sheets("sheet2").Cells(row, 2) = Sheets("sheet1").Range("C1")
Sheets("sheet2").Cells(row, 3) = Sheets("sheet1").Range("D1")
' end so on for all cells you like to copy


End Sub
 
sorry, found a little error,


Hi Gus,

think you can do it like this...

Sub test()
Dim row As Integer
row = Sheets("sheet2").Range("A65536").End(xlUp).Row + 1
Sheets("sheet2").Cells(row, 1) = Sheets("sheet1").Range("B1")
Sheets("sheet2").Cells(row, 2) = Sheets("sheet1").Range("C1")
Sheets("sheet2").Cells(row, 3) = Sheets("sheet1").Range("D1")
' end so on for all cells you like to copy
 
Back
Top