I need this to copy only the range that has "Yes"
 

Sub Complete() 'This is to copy completed Fraud Audits to Complete Page
Application.ScreenUpdating = False
Dim Mycell As Object
Sheets("Sheet1").Select
If
Range("B32,C32,D32,E32,F32,G32,H32,I32,J32,K32,L32 ,M32,N32,O32,P32,Q32") =
("Yes") Then
Range("B8:Q31").Copy
Sheets("Completed").Select
For Each Mycell In Range("A:A")
If Mycell.Value = "" Then
Mycell.Offset(rowOffset:=0, columNoffset:=0).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True 'transpose from the origanl setupExit For
Exit For
End If
Next

I need this to copy only the range that has "Yes"
 

hi,
I'm not sure you tried to achieve by this one :

Sub Complete()
Dim ShtSource As Worksheet
Dim RNGyes As Range
On Error Resume Next ' to handle if input box is empty

Set ShtSource = Sheets(InputBox _
("Enter source sheet name you wish to copy", _
"Source name", "sheet1"))

For Each RNGyes In ShtSource.Range("B32:Q32")
If UCase(RNGyes) = "YES" Then
'ShtSource.Range("B8:Q31").Copy
RNGyes.Offset(-24, 0).Resize(24, 1).Copy
Sheets("completed").Range("A65536"). _
End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteFormulas, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Else
Sheets("completed").Range("A65536").End(xlUp).Offs et(1, 0) =
RNGyes
End If
Next RNGyes
Application.CutCopyMode = False
End Sub

--
Regards,

Halim



"David A." wrote:

Sub Complete() 'This is to copy completed Fraud Audits to Complete Page
Application.ScreenUpdating = False
Dim Mycell As Object
Sheets("Sheet1").Select
If
Range("B32,C32,D32,E32,F32,G32,H32,I32,J32,K32,L32 ,M32,N32,O32,P32,Q32") =
("Yes") Then
Range("B8:Q31").Copy
Sheets("Completed").Select
For Each Mycell In Range("A:A")
If Mycell.Value = "" Then
Mycell.Offset(rowOffset:=0, columNoffset:=0).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True 'transpose from the origanl setupExit For
Exit For
End If
Next