Hi Mike,

Try:

'==========
Option Explicit

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim SH2 As Worksheet
Dim Rng As Range
Dim copyRng As Range
Dim destRng As Range
Dim iRow As Long
Dim i As Long
Dim CalcMode As Long
Dim sStr As String
Const dVal As Double = 1

Set WB = Workbooks("myBook.xls") '<<==== CHANGE

With WB
Set SH = .Sheets("Sheet1")
Set SH2 = .Sheets("Answers")
End With

With SH2
sStr = .Range("A3")
Set destRng = .Range("B4")
End With

With SH
iRow = LastRow(SH, .Columns("A:A"))
Set Rng = .Range("W1:BB" & iRow)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With SH
For i = 1 To iRow
If LCase(.Cells(i, "D").Value) = LCase(sStr) _
And .Cells(i, "BA").Value = dVal Then
If copyRng Is Nothing Then
Set copyRng = .Range(.Cells(i, "W"), _
.Cells(i, "BB"))
Else
Set copyRng = _
Union(.Range(.Cells(i, "W"), _
.Cells(i, "BB")), copyRng)
End If
End If
Next i
End With

If Not copyRng Is Nothing Then
copyRng.Copy Destination:=destRng
Else
'nothing found, do nothing
End If

XIT:

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub

'---------------
Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<==========



---
Regards.
Norman


"M.A.Tyler" <Great Lakes State wrote in message
...
Hi Norman,

First let me thank you for your efforts, I certainly appreciate the help.

I think we're close to the solution, just a couple tweeks. First there are
two worksheets Sheet1 and "Answers". It's the first "assumtion" that is
the
problem. Column D value (in sheet1) must = value in sheet "Answers" cell
A3
in addition too (second part) Sheet1 Column BA value = 1. Then you are
correct, copy data for all rows in columns W:BB, where both criteria are
met.

Also I would prefer, that once copied, the original data be kept, as it is
used from that location in subsequent calculations.

I apologise for keeping you guessing, again thanks for the help!

Regards,

Mike.


"Norman Jones" wrote:

Hi M,

I have assumed: that you want to copy data
for all rows in columns W:BB whe

- Column D value = "Answers"
and
- Column BA value = 1

I have further assumed that once copied,
the original data is to be deleted.

Assuming that this accords with your
requirements, in a standard module
(see below), paste the following code:

'==========
Option Explicit

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim copyRng As Range
Dim destRng As Range
Dim iRow As Long
Dim i As Long
Dim CalcMode As Long
Const sStr As String = "Answers"
Const dVal As Double = 1

Set WB = Workbooks("myBook.xls") '<<==== CHANGE
Set SH = WB.Sheets("Sheet1") '<<==== CHANGE

Set destRng = WB.Sheets("Answers").Range("B4")

With SH
iRow = LastRow(SH, .Columns("A:A"))
Set Rng = .Range("W1:BB" & iRow)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With SH
For i = 1 To iRow
If LCase(.Cells(i, "D").Value) = LCase(sStr) _
And .Cells(i, "BA").Value = dVal Then
If copyRng Is Nothing Then
Set copyRng = .Range(.Cells(i, "W"), _
.Cells(i, "BB"))
Else
Set copyRng = _
Union(.Range(.Cells(i, "W"), _
.Cells(i, "BB")), copyRng)
End If
End If
Next i
End With

If Not copyRng Is Nothing Then
copyRng.Copy Destination:=destRng
copyRng.ClearContents
Else
'nothing found, do nothing
End If

XIT:

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub

'---------------
Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

'<<==========

Alt-F11 to open the VBA Editor
Menu | Insert | Module | Paste the above code
Alt-F11 to return to Excell
Alt-F8 to open the Macros window
Select "|Tester" | Run



---
Regards.
Norman


"M.A.Tyler" <Great Lakes State wrote in message
...
Failed to mention where I would like to put the information being
moved.
To
Sheet"answers" starting in cell B4.

Thanks again.

"M.A.Tyler" wrote:

I need to move the data contained in Sheet1,W:BB, in rows that Sheet1,
Column
D match Sheet"Answers" A3 and that Column BA (sheet1) contains 1.

Can someone help with a method for performing this miracle?

Thanks,

M.A.Tyler