hobbiton73
02-15-2013, 09:50 AM
Hi, I wonder someone may be able to help me please.
@p45cal from this forum, helped me in putting the solution below together. The macro copies rows from one sheet to another if a cell within the given row matches a specific formula result.
Sub SpareResource()
Set xx = Sheets("Resource Summary").Range("A1,D1,F1,H1,J1,L1,N1,P1,R1,T1,V1,X1,Z1")
ARow = 5
Set cll = Sheets("Resource Summary").Cells(ARow, 1)
Do While Len(cll.Value) > 0
Rw = cll.Row
If Evaluate("SUM(--((IF(MOD(COLUMN($D$1:$Z$1)/2,1)=0,'Resource Summary'!$D$" & Rw & ":$Z$" & Rw & "))<(IF(MOD(COLUMN($C$1:$Y$1)/2,1)<>0,'Resource Summary'!$C$" & Rw & ":$Y$" & Rw & ")*0.85)))>0") Then
With Sheets("Staff With Spare Resource")
destrw = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
DestColm = 1
For Each celle In xx.Offset(Rw - 1).Cells
celle.Copy .Cells(destrw, DestColm)
DestColm = DestColm + 2
Next celle
End With
End If
Set cll = cll.Offset(1)
Loop
End Sub
I'd like to tweak this a little , but having spent all day trying to do so, I'm not sure how to find a resolution.
There are two chnages, which, if at all possibe I'd like to make.
In addition to the current copy and paste range I'd like to also include column B, and rather than pasting, I'd like, if at all possible, to change this to 'paste special'.
I'm not particularly good with VBA, but as I said, I've been trying to solve this all day without any success.
I just wondered whether someone may be able to look at this please and offer some guidance on how I may achieve this.
Many thanks and kind regards
Chris
@p45cal from this forum, helped me in putting the solution below together. The macro copies rows from one sheet to another if a cell within the given row matches a specific formula result.
Sub SpareResource()
Set xx = Sheets("Resource Summary").Range("A1,D1,F1,H1,J1,L1,N1,P1,R1,T1,V1,X1,Z1")
ARow = 5
Set cll = Sheets("Resource Summary").Cells(ARow, 1)
Do While Len(cll.Value) > 0
Rw = cll.Row
If Evaluate("SUM(--((IF(MOD(COLUMN($D$1:$Z$1)/2,1)=0,'Resource Summary'!$D$" & Rw & ":$Z$" & Rw & "))<(IF(MOD(COLUMN($C$1:$Y$1)/2,1)<>0,'Resource Summary'!$C$" & Rw & ":$Y$" & Rw & ")*0.85)))>0") Then
With Sheets("Staff With Spare Resource")
destrw = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
DestColm = 1
For Each celle In xx.Offset(Rw - 1).Cells
celle.Copy .Cells(destrw, DestColm)
DestColm = DestColm + 2
Next celle
End With
End If
Set cll = cll.Offset(1)
Loop
End Sub
I'd like to tweak this a little , but having spent all day trying to do so, I'm not sure how to find a resolution.
There are two chnages, which, if at all possibe I'd like to make.
In addition to the current copy and paste range I'd like to also include column B, and rather than pasting, I'd like, if at all possible, to change this to 'paste special'.
I'm not particularly good with VBA, but as I said, I've been trying to solve this all day without any success.
I just wondered whether someone may be able to look at this please and offer some guidance on how I may achieve this.
Many thanks and kind regards
Chris