Y
ytayta555
HI ALL
I have this macro whitch copy antire row
from one wbook to another If a value is
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
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("YTA2.xls").Close SaveChanges:=False
Workbooks.Open ("D:\WAVE\YTA3.xls")
Set FromWks3 = Workbooks("YTA3.xls").Worksheets("1")
With FromWks3
Set myRng1 = .Range("BD91:BD22000")
End With
With FromWks3
Set myRng2 = .Range("BD22001:BD44000")
End With
With FromWks3
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("YTA3.xls").Close SaveChanges:=False
End Sub
PART 4 OF TOPIC .
I want to work with 10 workbooks in one
macro . Name of this workbooks is from YTA1
to YTA10 .
MY PROBLEM IS : HOW CAN I declare the variables for
all workbooks ?THE ONLY PROBLEM IS TO DECLARE
VARIABLES IN THIS MACRO ! Please don't impresionate
for the big size of this macro , only problem is to declare
variables for the 10 workbooks and them Rng1 , Rng2 and
Rng3 ! !
Something I write wrong , because after first
workbook the macro don't work with speed !! It copy entire row in
the other workbook very slow !
(ps:I have 231 workbooks , named from YTA1 to YTA231,
but I think it cann't be posible to work with all them
in one only macro [ a macro cann't be bigger of 64 kb ! ])
Any sugestion will be wellkome ! Many thanks
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
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("YTA2.xls").Close SaveChanges:=False
Workbooks.Open ("D:\WAVE\YTA3.xls")
Set FromWks3 = Workbooks("YTA3.xls").Worksheets("1")
With FromWks3
Set myRng1 = .Range("BD91:BD22000")
End With
With FromWks3
Set myRng2 = .Range("BD22001:BD44000")
End With
With FromWks3
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("YTA3.xls").Close SaveChanges:=False
End Sub
PART 4 OF TOPIC .
I want to work with 10 workbooks in one
macro . Name of this workbooks is from YTA1
to YTA10 .
MY PROBLEM IS : HOW CAN I declare the variables for
all workbooks ?THE ONLY PROBLEM IS TO DECLARE
VARIABLES IN THIS MACRO ! Please don't impresionate
for the big size of this macro , only problem is to declare
variables for the 10 workbooks and them Rng1 , Rng2 and
Rng3 ! !
Something I write wrong , because after first
workbook the macro don't work with speed !! It copy entire row in
the other workbook very slow !
(ps:I have 231 workbooks , named from YTA1 to YTA231,
but I think it cann't be posible to work with all them
in one only macro [ a macro cann't be bigger of 64 kb ! ])
Any sugestion will be wellkome ! Many thanks