Hi ytayta555;

This may not help but i'l take a shot at it. My first suggestions would be
to switch to a database solution. If you have that much data is seems like
it might be time to to do that. Second, have you tried going back and forth
between the workbooks by using the Windows.Workbooks("xxx").Activate method.
Third, you might could bring all the worksheets into one workbook instead of
so many workbooks. Fourth you might use linking to have all 200 + workbook
answer sheets link into a master workbook.

I hope it helps and good luck,

"ytayta555" wrote:

HI ALL

I have this macro whitch copy antire row
from one wbook to another If a value is
=x ;it works with 1 workbook :

PART 1 OF TOPIC !

Option Explicit
Sub Copy_Ranges()

Dim FromWks As Worksheet
Dim DestWks As Worksheet
Dim NextRow As Long
Dim myCell As Range
Dim myRng As Range

Set FromWks = Workbooks("YTA1.xls").Worksheets("sheet1")
Set DestWks = Workbooks("R1.xls").Worksheets("sheet1")

With FromWks
Set myRng = .Range("BD91", .Cells(.Rows.Count,
"BD").End(xlUp))
End With

For Each myCell In myRng.Cells
If myCell.Value <= 32 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy _
Destination:=.Cells(NextRow, "A")
End With
End If
Next myCell


End Sub

PART 2 OF TOPIC .

I change this macro for loop in 3 steps ;
the macro becomed so :

Option Explicit
Sub Copy_Ranges()


Dim FromWks As Worksheet
Dim DestWks As Worksheet
Dim NextRow As Long
Dim myCell As Range
Dim myRng1 As Range
Dim myRng2 As Range
Dim myRng3 As Range

Set FromWks = Workbooks("Registru1.xls").Worksheets("1")
Set DestWks = Workbooks("R1.xls").Worksheets("1")

With FromWks
Set myRng1 = .Range("BD91:BD22000")
End With
With FromWks
Set myRng2 = .Range("BD22001:BD44000")
End With
With FromWks
Set myRng3 = .Range("BD44001:BD65536")
End With

Sheets("1").Select
Range("B91:B7000").Select
Selection.AutoFill Destination:=Range("B91:BB7000"),
Type:=xlFillDefault
Range("B7001:B14000").Select
Selection.AutoFill Destination:=Range("B7001:BB14000"),
Type:=xlFillDefault
Range("B14001:B22000").Select
Selection.AutoFill Destination:=Range("B14001:BB22000"),
Type:=xlFillDefault
For Each myCell In myRng1.Cells
If myCell.Value =33 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.cells(nextrow,"A").pastespecial paste:=xlpastevalues

End With
End If
Next myCell
Application.CutCopyMode = False
Sheets("1").Select
Range("C91:BB22005").Select
Selection.ClearContents
Sheets("1").Select
Range("B22001:B29000").Select
Selection.AutoFill Destination:=Range("B22001:BB29000"),
Type:=xlFillDefault
Range("B29001:B36000").Select
Selection.AutoFill Destination:=Range("B29001:BB36000"),
Type:=xlFillDefault
Range("B36001:B44000").Select
Selection.AutoFill Destination:=Range("B36001:BB44000"),
Type:=xlFillDefault
For Each myCell In myRng2.Cells
If myCell.Value =33 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.cells(nextrow,"A").pastespecial paste:=xlpastevalues

End With
End If
Next myCell
Application.CutCopyMode = False
Sheets("1").Select
Range("C22001:BB44005").Select
Selection.ClearContents
Sheets("1").Select
Range("B44001:B51000").Select
Selection.AutoFill Destination:=Range("B44001:BB51000"),
Type:=xlFillDefault
Range("B51001:B58000").Select
Selection.AutoFill Destination:=Range("B51001:BB58000"),
Type:=xlFillDefault
Range("B58001:B65536").Select
Selection.AutoFill Destination:=Range("B58001:BB65536"),
Type:=xlFillDefault
For Each myCell In myRng3.Cells
If myCell.Value =33 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.cells(nextrow,"A").pastespecial paste:=xlpastevalues

End With
End If
Next myCell

End Sub


PART 3 OF TOPIC .

For open 3 workbook this macro and
work with them , I ' ve done this changes :

Option Explicit
Sub Copy_Ranges()


Dim FromWks1 As Worksheet
Dim FromWks2 As Worksheet
Dim FromWks3 As Worksheet
Dim DestWks As Worksheet
Dim NextRow As Long
Dim myCell As Range
Dim myRng1 As Range
Dim myRng2 As Range
Dim myRng3 As Range


Workbooks.Open ("D:\WAVE\YTA1.xls")

Set FromWks1 = Workbooks("YTA1.xls").Worksheets("1")

Set DestWks = Workbooks("R1.xls").Worksheets("1")



With FromWks1
Set myRng1 = .Range("BD91:BD22000")
End With
With FromWks1
Set myRng2 = .Range("BD22001:BD44000")
End With
With FromWks1
Set myRng3 = .Range("BD44001:BD65536")
End With


Sheets("1").Select
Range("B91:B7000").Select
Selection.AutoFill Destination:=Range("B91:BB7000"),
Type:=xlFillDefault
Range("B7001:B14000").Select
Selection.AutoFill Destination:=Range("B7001:BB14000"),
Type:=xlFillDefault
Range("B14001:B22000").Select
Selection.AutoFill Destination:=Range("B14001:BB22000"),
Type:=xlFillDefault
For Each myCell In myRng1.Cells
If myCell.Value = 32 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

End With
End If
Next myCell
Application.CutCopyMode = False
Sheets("1").Select
Range("C91:BB22005").Select
Selection.ClearContents
Sheets("1").Select
Range("B22001:B29000").Select
Selection.AutoFill Destination:=Range("B22001:BB29000"),
Type:=xlFillDefault
Range("B29001:B36000").Select
Selection.AutoFill Destination:=Range("B29001:BB36000"),
Type:=xlFillDefault
Range("B36001:B44000").Select
Selection.AutoFill Destination:=Range("B36001:BB44000"),
Type:=xlFillDefault
For Each myCell In myRng2.Cells
If myCell.Value = 32 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

End With
End If
Next myCell
Application.CutCopyMode = False
Sheets("1").Select
Range("C22001:BB44005").Select
Selection.ClearContents
Sheets("1").Select
Range("B44001:B51000").Select
Selection.AutoFill Destination:=Range("B44001:BB51000"),
Type:=xlFillDefault
Range("B51001:B58000").Select
Selection.AutoFill Destination:=Range("B51001:BB58000"),
Type:=xlFillDefault
Range("B58001:B65536").Select
Selection.AutoFill Destination:=Range("B58001:BB65536"),
Type:=xlFillDefault
For Each myCell In myRng3.Cells
If myCell.Value = 32 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

End With
End If
Next myCell
Application.CutCopyMode = False
Sheets("1").Select
Range("C44001:BB65536").Select
Selection.ClearContents
Workbooks("YTA1.xls").Close SaveChanges:=False

Workbooks.Open ("D:\WAVE\YTA2.xls")

Set FromWks2 = Workbooks("YTA2.xls").Worksheets("1")
With FromWks2
Set myRng1 = .Range("BD91:BD22000")
End With
With FromWks2
Set myRng2 = .Range("BD22001:BD44000")
End With
With FromWks2
Set myRng3 = .Range("BD44001:BD65536")
End With


Sheets("1").Select
Range("B91:B7000").Select
Selection.AutoFill Destination:=Range("B91:BB7000"),
Type:=xlFillDefault
Range("B7001:B14000").Select
Selection.AutoFill Destination:=Range("B7001:BB14000"),
Type:=xlFillDefault
Range("B14001:B22000").Select
Selection.AutoFill Destination:=Range("B14001:BB22000"),
Type:=xlFillDefault
For Each myCell In myRng1.Cells
If myCell.Value = 32 Then
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

End With
End If
Next myCell
Application.CutCopyMode = False
Sheets("1").Select
Range("C91:BB22005").Select
Selection.ClearContents
Sheets("1").Select
Range("B22001:B29000").Select
Selection.AutoFill Destination:=Range("B22001:BB29000"),
Type:=xlFillDefault
Range("B29001:B36000").Select