Some changes in a Macro ..

Y

ytayta555

Thanks to mr. Dave Peterson I have this macro :
(simplified )

__________________________
Sub NEWWAY1()
'

Dim FromWks1 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:BD65536")
End With

Sheets("1").Select
Range("V91:V7000").Select
Selection.AutoFill Destination:=Range("V91:BB7000"),
Type:=xlFillDefault
Range("V7001:V14000").Select
Selection.AutoFill Destination:=Range("V7001:BB14000"),
Type:=xlFillDefault
Range("V14001:V22000").Select
Selection.AutoFill Destination:=Range("V14001:BB22000"),
Type:=xlFillDefault
Range("V22001:V29000").Select
Selection.AutoFill Destination:=Range("V22001:BB29000"),
Type:=xlFillDefault
Range("V29001:V36000").Select
Selection.AutoFill Destination:=Range("V29001:BB36000"),
Type:=xlFillDefault
Range("V36001:V44000").Select
Selection.AutoFill Destination:=Range("V36001:BB44000"),
Type:=xlFillDefault
Range("V44001:V51000").Select
Selection.AutoFill Destination:=Range("V44001:BB51000"),
Type:=xlFillDefault
Range("V51001:V58000").Select
Selection.AutoFill Destination:=Range("V51001:BB58000"),
Type:=xlFillDefault
Range("V58001:V65536").Select
Selection.AutoFill Destination:=Range("V58001:BB65536"),
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

Workbooks("YTA1.xls").Close SaveChanges:=False

End Sub

This macro work perfect for me , to find a value in column BD , and if
value is >=33
to copy entire row and paste it in another workbook .

Now , I have another two (or three) little ,,needs ,, in this
macro :
_______________________________________________________
1). First need is the next :
IF value - For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then -
then , to select the cell of the *SAME* row ,*BUT* in Column (BB ) ,
and to do an autofill from BB
(in the same row) to the begin of sheet , it means Column (A) ;
{I know that here must be use an resize , a line of code like this :
[myCell or ActiveCell.Select.Selection(Resize(x;y) .Selection.Autofill
Destination .....Column A..],
but I don't know very well to do this to work } .
______________________________________________________
2). My second need is :
For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then -
then , to show in the same row , in Column BF the name of the
workbook ;
{I know too , the line of code must to look something like this
[ myCell or ActiveCell.ActiveWorkbook or ThisWorkbook.Name ], but I
don't know very well how to make it to work]} .
______________________________________________________
3). Only and only if it is possible ,my 3-th need is :
For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then -
then , in the *SAME* row , in Column BE , to input the function
=ROW() , which return the number of current row .
______________________________________________________

The IF steps , must be in this order :need 1, need 2 and then need
3 ;
And , only after this 3 steps , to copy entire row in this other
workbook with Dave Peterson
line of code , which work perfect :
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
______________________________________________________
This 3 IF' s I must them and with my IF must to be in a good arrange
in macro, to action in the steps' order I explained .

Thank you very very much for your time .
 
J

Joel

I cleaned up the code to make sure it worked properly.

Sub NEWWAY1()
'

Dim FromWks1 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 YTA1 = Workbooks.Open("D:\WAVE\YTA1.xls")

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


With FromWks1
Set myRng1 = .Range("BD91:BD65536")
End With

With FromWks1
.Range("V91:V7000").AutoFill _
Destination:=.Range("V91:BB7000"), Type:=xlFillDefault
.Range("V7001:V14000").AutoFill _
Destination:=.Range("V7001:BB14000"), Type:=xlFillDefault
Range("V14001:V22000").AutoFill _
Destination:=.Range("V14001:BB22000"), Type:=xlFillDefault
.Range("V22001:V29000").AutoFill _
Destination:=.Range("V22001:BB29000"), Type:=xlFillDefault
.Range("V29001:V36000").AutoFill _
Destination:=.Range("V29001:BB36000"), Type:=xlFillDefault
.Range("V36001:V44000").AutoFill _
Destination:=.Range("V36001:BB44000"), Type:=xlFillDefault
.Range("V44001:V51000").AutoFill _
Destination:=.Range("V44001:BB51000"), Type:=xlFillDefault
.Range("V51001:V58000").AutoFill _
Destination:=.Range("V51001:BB58000"), Type:=xlFillDefault
.Range("V58001:V65536").AutoFill _
Destination:=.Range("V58001:BB65536"), Type:=xlFillDefault

For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then
With FromWks1
.Range("BB" & myCell.Row).AutoFill _
Destination:=.Range("BB" & myCell.Row & ":A" & myCell.Row), _
Type:=xlFillDefault
.Range("BE" & myCell.Row) = myCell.Row
.Range("BF" & myCell.Row) = YTA1.Name
End With
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 With
Application.CutCopyMode = False

Workbooks("YTA1.xls").Close SaveChanges:=False

End Sub



ytayta555 said:
Thanks to mr. Dave Peterson I have this macro :
(simplified )

__________________________
Sub NEWWAY1()
'

Dim FromWks1 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:BD65536")
End With

Sheets("1").Select
Range("V91:V7000").Select
Selection.AutoFill Destination:=Range("V91:BB7000"),
Type:=xlFillDefault
Range("V7001:V14000").Select
Selection.AutoFill Destination:=Range("V7001:BB14000"),
Type:=xlFillDefault
Range("V14001:V22000").Select
Selection.AutoFill Destination:=Range("V14001:BB22000"),
Type:=xlFillDefault
Range("V22001:V29000").Select
Selection.AutoFill Destination:=Range("V22001:BB29000"),
Type:=xlFillDefault
Range("V29001:V36000").Select
Selection.AutoFill Destination:=Range("V29001:BB36000"),
Type:=xlFillDefault
Range("V36001:V44000").Select
Selection.AutoFill Destination:=Range("V36001:BB44000"),
Type:=xlFillDefault
Range("V44001:V51000").Select
Selection.AutoFill Destination:=Range("V44001:BB51000"),
Type:=xlFillDefault
Range("V51001:V58000").Select
Selection.AutoFill Destination:=Range("V51001:BB58000"),
Type:=xlFillDefault
Range("V58001:V65536").Select
Selection.AutoFill Destination:=Range("V58001:BB65536"),
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

Workbooks("YTA1.xls").Close SaveChanges:=False

End Sub

This macro work perfect for me , to find a value in column BD , and if
value is >=33
to copy entire row and paste it in another workbook .

Now , I have another two (or three) little ,,needs ,, in this
macro :
_______________________________________________________
1). First need is the next :
IF value - For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then -
then , to select the cell of the *SAME* row ,*BUT* in Column (BB ) ,
and to do an autofill from BB
(in the same row) to the begin of sheet , it means Column (A) ;
{I know that here must be use an resize , a line of code like this :
[myCell or ActiveCell.Select.Selection(Resize(x;y) .Selection.Autofill
Destination .....Column A..],
but I don't know very well to do this to work } .
______________________________________________________
2). My second need is :
For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then -
then , to show in the same row , in Column BF the name of the
workbook ;
{I know too , the line of code must to look something like this
[ myCell or ActiveCell.ActiveWorkbook or ThisWorkbook.Name ], but I
don't know very well how to make it to work]} .
______________________________________________________
3). Only and only if it is possible ,my 3-th need is :
For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then -
then , in the *SAME* row , in Column BE , to input the function
=ROW() , which return the number of current row .
______________________________________________________

The IF steps , must be in this order :need 1, need 2 and then need
3 ;
And , only after this 3 steps , to copy entire row in this other
workbook with Dave Peterson
line of code , which work perfect :
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
______________________________________________________
This 3 IF' s I must them and with my IF must to be in a good arrange
in macro, to action in the steps' order I explained .

Thank you very very much for your time .
Click to expand...
 
Y

ytayta555

It's fantastic ! Work perfect ! It's a dream to be here !

I only change the line of code .Range("BF" & myCell.Row) = YTA1.Name
with .Range("BF" & myCell.Row) = ActiveWorkbook.Name , because this
macro will run between 231 wbooks , with different names .

I'd like to know and some another things :
__________________________________________________________

1). I have 231 wbooks , named from
YTA1.xls to YTA231.xls ,in a folder named WAVE , in D:\ ;
because I don't know to loop through the wbooks of folder , I have 231
macros
which call each other ;it's be very easy to get the line of code which
call
in this folder the wbooks named from YTA1 +1 to YTA231 , to open
each of
them , do what is in the macro above , then close save changes =
false ;
I know that it must be used another ,, For each wbook in ... ,, but
I'm not a programmer ..
__________________________________________________________

2). Only it is possible , I'd want to work instead of :
With DestWks
NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
myCell.EntireRow.Copy
.Cells(NextRow, "A").PasteSpecial _
Paste:=xlPasteValues
End With
with Cut , (instead of Copy with Cut ) but in this rows are
functions , and the references of functions
(what I,d want to see ) because is different the range of copy or cut
and paste ,
became #REF! #REF! , in the most of cases ;only and only it is
possible , I'd
like to try Cut metode in my macro .
__________________________________________________________

Words are to small to thank you , mr. Joel
 
J

Joel

I usually prefer to open all the files in a directory rather than to specify
1 to 231. With specifying 1 to 231 if you add another file you have to
modify the macro.

This code will get all the files in the directory using the * as a wildcard
--------------------------------------------------------------------------------
Folder = "D:\WAVE\"
Files = Folder & "YTA*.XLS"
FName = Dir(Files)
do while FName <> ""
Set YTA = Workbooks.Open(Folder & FName)

'enter your code here

FName = Dir()
loop

--------------------------------------------------------------


I can't think of an easy way of the NA problem except to remove all the
formulas by using pastespecial.



Sub NEWWAY1()
'

Dim FromWks1 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 DestWks = Workbooks("R1.xls").Worksheets("1")
NextRow = DestWks.Cells(Rows.Count, "BD").End(xlUp).Row + 1


For BookCount = 1 To 231
Set YTA = Workbooks.Open("D:\WAVE\YTA" & _
BookCount & ".xls")

Set FromWks1 = YTA.Worksheets("1")


With FromWks1
Set myRng1 = .Range("BD91:BD65536")
End With

With FromWks1
.Range("V91:V7000").AutoFill _
Destination:=.Range("V91:BB7000"), _
Type:=xlFillDefault
.Range("V7001:V14000").AutoFill _
Destination:=.Range("V7001:BB14000"), _
Type:=xlFillDefault
.Range("V14001:V22000").AutoFill _
Destination:=.Range("V14001:BB22000"), _
Type:=xlFillDefault
.Range("V22001:V29000").AutoFill _
Destination:=.Range("V22001:BB29000"), _
Type:=xlFillDefault
.Range("V29001:V36000").AutoFill _
Destination:=.Range("V29001:BB36000"), _
Type:=xlFillDefault
.Range("V36001:V44000").AutoFill _
Destination:=.Range("V36001:BB44000"), _
Type:=xlFillDefault
.Range("V44001:V51000").AutoFill _
Destination:=.Range("V44001:BB51000"), _
Type:=xlFillDefault
.Range("V51001:V58000").AutoFill _
Destination:=.Range("V51001:BB58000"), _
Type:=xlFillDefault
.Range("V58001:V65536").AutoFill _
Destination:=.Range("V58001:BB65536"), _
Type:=xlFillDefault

For Each myCell In myRng1.Cells
If myCell.Value >= 33 Then
With FromWks1
.Range("BB" & myCell.Row).AutoFill _
Destination:=.Range("BB" & myCell.Row & _
":A" & myCell.Row), _
Type:=xlFillDefault
.Range("BE" & myCell.Row) = myCell.Row
.Range("BF" & myCell.Row) = YTA.Name
End With
With DestWks
myCell.EntireRow.Copy
.Cells(NextRow, "A").PasteSpecial _
Paste:=xlPasteValues
NextRow = NextRow + 1
End With
End If
Next myCell
End With

YTA.Close SaveChanges:=False

Next BookCount

Application.CutCopyMode = False

End Sub
 
Y

ytayta555

It works like an UFO ! Big help for me , very big . You made me a
man .
Thanks and best wishes
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

DECLARE VARIABLES PROBLEM 7
Change a Macro - Copy in Columns instead of copy in Rows 7
I have to run macro twice to work? Why 6
same macro on multiple sheets 4
Add row dynamically 15
Copy a Cell with a macro 2
Y doens't this work? 3
Macro that deletes and pastes filterd rows and then some 2

Top