Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
AutoRun Macro with a delay to give user the choice to cancel the macro | Excel Programming | |||
Macro not showing in Tools/Macro/Macros yet show up when I goto VBA editor | Excel Programming | |||
macro to delete entire rows when column A is blank ...a quick macro | Excel Programming | |||
Start Macro / Stop Macro / Restart Macro | Excel Programming |