Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro Question
Hey All,
using the following vba code, i am trying to copy all the rows that have the word "OK" on column A, example i have data on row 1 to 20 and the following rows have "OK" on column A rwo 2, row 5 and row 6, i want the macro to search for the word "OK" on column A and copy the entire line inn sheet on the next empty row. my current macro find the word "OK" however keeps copying the first line for the number of "OK" it fined, in my example it will copy row 2 data three times on sheet2. Sub A() Dim lastrow As Long Dim r As Long lastrow = Range("A" & Rows.Count).End(xlUp).row For r = lastrow To 1 Step -1 If InStr(1, Cells(r, 1).Value, "OK") 0 Then Cells(r, 1).EntireRow.Select Selection.Copy Sheets("Sheet2").Select Range("a1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste Sheets("sheet1").Select End If Next End Sub Appreciate all the help thanks david |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro Question
David,
Try it like this. Note that also I've qualified the ranges using SrcSht and DstSht. Your code told us the data are going to sheet 2 and I've assumed sheet1 as the source sheet so change to suit. I also added VbTextCompare to your Instr line which stops it being case sensitive, simply take this out if you want it to remain case sensitive Sub A() Dim lastrow As Long Dim CopyRange As Range Dim r As Long Set SrcSht = Sheets("Sheet1") Set DstSht = Sheets("Sheet2") With SrcSht lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row For r = 1 To lastrow If InStr(1, .Cells(r, 1).Value, "OK", vbTextCompare) 0 Then If CopyRange Is Nothing Then Set CopyRange = .Rows(r).EntireRow Else Set CopyRange = Union(CopyRange, .Rows(r).EntireRow) End If End If Next End With If Not CopyRange Is Nothing Then lastrow = DstSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row CopyRange.Copy Destination:=DstSht.Range("A" & lastrow + 1) End If End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "David" wrote: Hey All, using the following vba code, i am trying to copy all the rows that have the word "OK" on column A, example i have data on row 1 to 20 and the following rows have "OK" on column A rwo 2, row 5 and row 6, i want the macro to search for the word "OK" on column A and copy the entire line inn sheet on the next empty row. my current macro find the word "OK" however keeps copying the first line for the number of "OK" it fined, in my example it will copy row 2 data three times on sheet2. Sub A() Dim lastrow As Long Dim r As Long lastrow = Range("A" & Rows.Count).End(xlUp).row For r = lastrow To 1 Step -1 If InStr(1, Cells(r, 1).Value, "OK") 0 Then Cells(r, 1).EntireRow.Select Selection.Copy Sheets("Sheet2").Select Range("a1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste Sheets("sheet1").Select End If Next End Sub Appreciate all the help thanks david |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro Question
Hi Mike,
you are great, it works perfectly. thank you "Mike H" wrote: David, Try it like this. Note that also I've qualified the ranges using SrcSht and DstSht. Your code told us the data are going to sheet 2 and I've assumed sheet1 as the source sheet so change to suit. I also added VbTextCompare to your Instr line which stops it being case sensitive, simply take this out if you want it to remain case sensitive Sub A() Dim lastrow As Long Dim CopyRange As Range Dim r As Long Set SrcSht = Sheets("Sheet1") Set DstSht = Sheets("Sheet2") With SrcSht lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row For r = 1 To lastrow If InStr(1, .Cells(r, 1).Value, "OK", vbTextCompare) 0 Then If CopyRange Is Nothing Then Set CopyRange = .Rows(r).EntireRow Else Set CopyRange = Union(CopyRange, .Rows(r).EntireRow) End If End If Next End With If Not CopyRange Is Nothing Then lastrow = DstSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row CopyRange.Copy Destination:=DstSht.Range("A" & lastrow + 1) End If End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "David" wrote: Hey All, using the following vba code, i am trying to copy all the rows that have the word "OK" on column A, example i have data on row 1 to 20 and the following rows have "OK" on column A rwo 2, row 5 and row 6, i want the macro to search for the word "OK" on column A and copy the entire line inn sheet on the next empty row. my current macro find the word "OK" however keeps copying the first line for the number of "OK" it fined, in my example it will copy row 2 data three times on sheet2. Sub A() Dim lastrow As Long Dim r As Long lastrow = Range("A" & Rows.Count).End(xlUp).row For r = lastrow To 1 Step -1 If InStr(1, Cells(r, 1).Value, "OK") 0 Then Cells(r, 1).EntireRow.Select Selection.Copy Sheets("Sheet2").Select Range("a1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste Sheets("sheet1").Select End If Next End Sub Appreciate all the help thanks david |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro Question
Hi Mike,
i running into a little problem, macro works fine for about 20 lines, then i get an error message "Run time error '1004' and copy method of range class failed" I appreciate your help. thanks "Mike H" wrote: David, Try it like this. Note that also I've qualified the ranges using SrcSht and DstSht. Your code told us the data are going to sheet 2 and I've assumed sheet1 as the source sheet so change to suit. I also added VbTextCompare to your Instr line which stops it being case sensitive, simply take this out if you want it to remain case sensitive Sub A() Dim lastrow As Long Dim CopyRange As Range Dim r As Long Set SrcSht = Sheets("Sheet1") Set DstSht = Sheets("Sheet2") With SrcSht lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row For r = 1 To lastrow If InStr(1, .Cells(r, 1).Value, "OK", vbTextCompare) 0 Then If CopyRange Is Nothing Then Set CopyRange = .Rows(r).EntireRow Else Set CopyRange = Union(CopyRange, .Rows(r).EntireRow) End If End If Next End With If Not CopyRange Is Nothing Then lastrow = DstSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row CopyRange.Copy Destination:=DstSht.Range("A" & lastrow + 1) End If End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "David" wrote: Hey All, using the following vba code, i am trying to copy all the rows that have the word "OK" on column A, example i have data on row 1 to 20 and the following rows have "OK" on column A rwo 2, row 5 and row 6, i want the macro to search for the word "OK" on column A and copy the entire line inn sheet on the next empty row. my current macro find the word "OK" however keeps copying the first line for the number of "OK" it fined, in my example it will copy row 2 data three times on sheet2. Sub A() Dim lastrow As Long Dim r As Long lastrow = Range("A" & Rows.Count).End(xlUp).row For r = lastrow To 1 Step -1 If InStr(1, Cells(r, 1).Value, "OK") 0 Then Cells(r, 1).EntireRow.Select Selection.Copy Sheets("Sheet2").Select Range("a1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste Sheets("sheet1").Select End If Next End Sub Appreciate all the help thanks david |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel 2007 Macro/VB Question DDE Question | Excel Worksheet Functions | |||
Macro question | Excel Discussion (Misc queries) | |||
Macro Question | New Users to Excel | |||
MACRO QUESTION | Excel Worksheet Functions | |||
Question about macro | Excel Discussion (Misc queries) |