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