Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 247
Default Some changes in a Macro ..

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 .
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Some changes in a Macro ..

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" wrote:

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 .

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 247
Default Some changes in a Macro ..

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
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Some changes in a Macro ..

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


"ytayta555" wrote:

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

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 247
Default Some changes in a Macro ..

It works like an UFO ! Big help for me , very big . You made me a
man .
Thanks and best wishes
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro recorded... tabs & file names changed, macro hangs Steve Excel Worksheet Functions 3 October 30th 09 11:41 AM
AutoRun Macro with a delay to give user the choice to cancel the macro wanderlust Excel Programming 2 September 28th 07 04:09 PM
Macro not showing in Tools/Macro/Macros yet show up when I goto VBA editor [email protected] Excel Programming 2 March 30th 07 07:48 PM
macro to delete entire rows when column A is blank ...a quick macro vikram Excel Programming 4 May 3rd 04 08:45 PM
Start Macro / Stop Macro / Restart Macro Pete[_13_] Excel Programming 2 November 21st 03 05:04 PM


All times are GMT +1. The time now is 02:03 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"