Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi
I have several rows of information in a worksheet I need a macro or code to select only the rows that do not have the word "keep" anywhere in them, copy those rows and open a new workbook and paste them into the worksheet then save the worksheet in my documents with month as the filename. I manage to do this with a macro selecting specific rows by drag and select but the layout changes so this no good. Help appreciated Thanks |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Kim,
'------------------- I have several rows of information in a worksheet I need a macro or code to select only the rows that do not have the word "keep" anywhere in them, copy those rows and open a new workbook and paste them into the worksheet then save the worksheet in my documents with month as the filename. I manage to do this with a macro selecting specific rows by drag and select but the layout changes so this no good. '------------------- Try something like; '================ Public Sub Tester() Dim WB As Workbook Dim SH As Worksheet Dim destSH As Worksheet Dim rng As Range Dim rCell As Range Dim Rng2 As Range Dim iRow As Long Dim CalcMode As Long Const sStr As String = "keep" '<<===== CHANGE Set WB = Workbooks("MyBook.xls") '<<===== CHANGE Set SH = WB.Sheets("Sheet1") '<<===== CHANGE With SH iRow = .Cells(Rows.Count, "A").End(xlUp).Row Set rng = SH.Range("A1:A" & iRow) End With On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each rCell In rng.Cells If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") Then If Rng2 Is Nothing Then Set Rng2 = rCell Else Set Rng2 = Union(rCell, Rng2) End If End If Next rCell If Not Rng2 Is Nothing Then With WB Set destSH = .Worksheets.Add( _ After:=.Sheets(.Sheets.Count)) End With With destSH Rng2.Copy Destination:=destSH.Range("A1") .Name = Format(Date, "mmmm") .Copy End With With ActiveWorkbook .SaveAs Filename:=destSH.Name & ".xls" .Close SaveChanges:=False End With End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With End Sub '<<================ --- Regards, Norman |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Kim,
Re-reading your post, replace: If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") Then with If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") = 0 Then --- Regards, Norman |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Thanks Norman it produced the workbook but no data pasted. I moved my data to
cell A1 tried again . It did paste only the rows but only the data in column A how can get to paste data from the other columns? I tried to figure this out by looking a t the code but can't get there! Thanks "Norman Jones" wrote: Hi Kim, Re-reading your post, replace: If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") Then with If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") = 0 Then --- Regards, Norman |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Kim,
'------------------ Thanks Norman it produced the workbook but no data pasted. I moved my data to cell A1 tried again . It did paste only the rows but only the data in column A how can get to paste data from the other columns? I tried to figure this out by looking a t the code but can't get there! '------------------ (1) Change: Set rng = SH.Range("A1:A" & iRow) to reflect a column which encompasses all of your data. (2) Change Rng2.Copy Destination:=destSH.Range("A1") to: Rng2EntireRow.Copy Destination:=destSH.Range("A1") --- Regards, Norman |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Norman
I chaged the range in the code from A1:A to A1:Z400 This caught the data was this the correct approach? Thanks "kim" wrote: Thanks Norman it produced the workbook but no data pasted. I moved my data to cell A1 tried again . It did paste only the rows but only the data in column A how can get to paste data from the other columns? I tried to figure this out by looking a t the code but can't get there! Thanks "Norman Jones" wrote: Hi Kim, Re-reading your post, replace: If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") Then with If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") = 0 Then --- Regards, Norman |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Kim,
'---------------- I chaged the range in the code from A1:A to A1:Z400 This caught the data was this the correct approach? '---------------- See my response to your previous post.. However, it should be necessary only to replace 'A' with a column that defines the last data row. To copy the entire data rows, adopt also my second suggestion. --- Regards, Norman |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Kim,
To avoid the potential problem of column specification, try the following version: '================ Public Sub Tester() Dim WB As Workbook Dim sh As Worksheet Dim destSH As Worksheet Dim rng As Range Dim rCell As Range Dim Rng2 As Range Dim iRow As Long Dim CalcMode As Long Const sStr As String = "keep" '<<===== CHANGE Set WB = Workbooks("MyBook.xls") '<<===== CHANGE Set sh = WB.Sheets("Sheet1") '<<===== CHANGE With sh iRow = LastRow(sh) Set rng = sh.Range("A1:A" & iRow) End With On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each rCell In rng.Cells If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") = 0 Then If Rng2 Is Nothing Then Set Rng2 = rCell Else Set Rng2 = Union(rCell, Rng2) End If End If Next rCell If Not Rng2 Is Nothing Then With WB Set destSH = .Worksheets.Add( _ After:=.Sheets(.Sheets.Count)) End With With destSH Rng2.EntireRow.Copy Destination:=destSH.Range("A1") .Name = Format(Date, "mmmm") .Copy End With With ActiveWorkbook .SaveAs Filename:=destSH.Name & ".xls" .Close SaveChanges:=False End With End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With End Sub '--------------- Function LastRow(sh As Worksheet, _ Optional rng As Range) If rng Is Nothing Then Set rng = sh.Cells End If On Error Resume Next LastRow = rng.Find(What:="*", _ After:=rng.Cells(1), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function '<<================ --- Regards, Norman |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Norman
Looking at this, away from the code ,for what I need to record it makes more sense to have the code copy the rows where the word "Keep" does not appear is it possible to change the code to do this? Thanks for your help "Norman Jones" wrote: Hi Kim, '------------------ Thanks Norman it produced the workbook but no data pasted. I moved my data to cell A1 tried again . It did paste only the rows but only the data in column A how can get to paste data from the other columns? I tried to figure this out by looking a t the code but can't get there! '------------------ (1) Change: Set rng = SH.Range("A1:A" & iRow) to reflect a column which encompasses all of your data. (2) Change Rng2.Copy Destination:=destSH.Range("A1") to: Rng2EntireRow.Copy Destination:=destSH.Range("A1") --- Regards, Norman |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Sorry please ignore last post!
"kim" wrote: Hi Norman Looking at this, away from the code ,for what I need to record it makes more sense to have the code copy the rows where the word "Keep" does not appear is it possible to change the code to do this? Thanks for your help "Norman Jones" wrote: Hi Kim, '------------------ Thanks Norman it produced the workbook but no data pasted. I moved my data to cell A1 tried again . It did paste only the rows but only the data in column A how can get to paste data from the other columns? I tried to figure this out by looking a t the code but can't get there! '------------------ (1) Change: Set rng = SH.Range("A1:A" & iRow) to reflect a column which encompasses all of your data. (2) Change Rng2.Copy Destination:=destSH.Range("A1") to: Rng2EntireRow.Copy Destination:=destSH.Range("A1") --- Regards, Norman |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Thanks Norman that last code seems to have worked and done the job. One more
thing it puts the copied information in a new workbook is it possible to put some code in there t0 save the workbook in my documents? Thanks "Norman Jones" wrote: Hi Kim, '------------------ Thanks Norman it produced the workbook but no data pasted. I moved my data to cell A1 tried again . It did paste only the rows but only the data in column A how can get to paste data from the other columns? I tried to figure this out by looking a t the code but can't get there! '------------------ (1) Change: Set rng = SH.Range("A1:A" & iRow) to reflect a column which encompasses all of your data. (2) Change Rng2.Copy Destination:=destSH.Range("A1") to: Rng2EntireRow.Copy Destination:=destSH.Range("A1") --- Regards, Norman |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Kim,
'------------------ Thanks Norman that last code seems to have worked and done the job. One more thing it puts the copied information in a new workbook is it possible to put some code in there t0 save the workbook in my documents? '------------------ I assumed from your initial question that you wished to create a new workbook to contain the copied data. Now I am no longer sure of your intent. Is the the original workbook to be saved under a new name amd path? --- Regards, Norman |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Norman,
Sorry, your code does exactly that - it was a question at the end of a long day! Thank you for your patience and your expertise. Really appreciated. Chris "Norman Jones" wrote: Hi Kim, '------------------ Thanks Norman that last code seems to have worked and done the job. One more thing it puts the copied information in a new workbook is it possible to put some code in there t0 save the workbook in my documents? '------------------ I assumed from your initial question that you wished to create a new workbook to contain the copied data. Now I am no longer sure of your intent. Is the the original workbook to be saved under a new name amd path? --- Regards, Norman |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
This is an extension of the query above as Im trying to take this further.
I want to sort the columns before it is pasted into another worksheet . I have tried the code Sub sorted() ' ' sorted Macro ' ' ' Range("A1:D7381").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:= _ Range("C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _ DataOption2:=xlSortNormal End Sub This from copying a recorded macro - I tried to paste this into the code Norman kindly supplied but can't get it to rub . Could anyone give me a few tips? Thanks "kim" wrote: Norman, Sorry, your code does exactly that - it was a question at the end of a long day! Thank you for your patience and your expertise. Really appreciated. Chris "Norman Jones" wrote: Hi Kim, '------------------ Thanks Norman that last code seems to have worked and done the job. One more thing it puts the copied information in a new workbook is it possible to put some code in there t0 save the workbook in my documents? '------------------ I assumed from your initial question that you wished to create a new workbook to contain the copied data. Now I am no longer sure of your intent. Is the the original workbook to be saved under a new name amd path? --- Regards, Norman |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy specific rows to a new sheet
Hi Kim.
Try keeping the sort routine as a separate procedure and call it from the main procedure, For example, try: '================ Public Sub Tester() Dim WB As Workbook Dim SH As Worksheet Dim destSH As Worksheet Dim Rng As Range Dim rCell As Range Dim Rng2 As Range Dim iRow As Long Dim CalcMode As Long Const sStr As String = "keep" '<<===== CHANGE Set WB = Workbooks("MyBook.xls") '<<===== CHANGE Set SH = WB.Sheets("Sheet1") '<<===== CHANGE With SH iRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Rng = SH.Range("A1:A" & iRow) End With Call MySort(Rng) On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each rCell In Rng.Cells If Application.CountIf( _ rCell.EntireRow, "*" & sStr & "*") = 0 Then If Rng2 Is Nothing Then Set Rng2 = rCell Else Set Rng2 = Union(rCell, Rng2) End If End If Next rCell If Not Rng2 Is Nothing Then With WB Set destSH = .Worksheets.Add( _ After:=.Sheets(.Sheets.Count)) End With With destSH Rng2.EntireRow.Copy Destination:=destSH.Range("A1") .Name = Format(Date, "mmmm") .Copy End With With ActiveWorkbook .SaveAs Filename:=destSH.Name & ".xls" .Close SaveChanges:=False End With End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With End Sub '-------------------- Public Sub MySort(Rng As Range) With Rng .Resize(, 4).Sort Key1:=.Range("B2"), _ Order1:=xlAscending, _ Key2:=.Range("C2"), _ Order2:=xlAscending, _ Header:=xlGuess, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, _ DataOption2:=xlSortNormal End With End Sub '<<============= --- Regards, Norman "kim" wrote in message ... This is an extension of the query above as Im trying to take this further. I want to sort the columns before it is pasted into another worksheet . I have tried the code Sub sorted() ' ' sorted Macro ' ' ' Range("A1:D7381").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:= _ Range("C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _ DataOption2:=xlSortNormal End Sub This from copying a recorded macro - I tried to paste this into the code Norman kindly supplied but can't get it to rub . Could anyone give me a few tips? Thanks "kim" wrote: Norman, Sorry, your code does exactly that - it was a question at the end of a long day! Thank you for your patience and your expertise. Really appreciated. Chris "Norman Jones" wrote: Hi Kim, '------------------ Thanks Norman that last code seems to have worked and done the job. One more thing it puts the copied information in a new workbook is it possible to put some code in there t0 save the workbook in my documents? '------------------ I assumed from your initial question that you wished to create a new workbook to contain the copied data. Now I am no longer sure of your intent. Is the the original workbook to be saved under a new name amd path? --- Regards, Norman |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy rows to new sheet based on specific cell value | Excel Worksheet Functions | |||
Copy / paste only specific rows | Excel Discussion (Misc queries) | |||
copy specific rows using "IF" to another sheet | Excel Worksheet Functions | |||
COPY AND PASTE SPECIFIC ROWS | Excel Discussion (Misc queries) | |||
Copy rows with a specific value in column A | Excel Programming |