Home |
Search |
Today's Posts |
|
#1
|
|||
|
|||
Macro to Find, Cut, and Paste
I have 2 LONG columns that I need to make into MANY. I want to find a word in
the active column, cut from that word down to the end and the adjacent cells; then paste them at the top of the next column. and do this for all occurences of that word. |
#2
|
|||
|
|||
I'm confused about the two columns. I'm thinking that you want to break up your
list of two columns based on the word in column A. But paste both columns to the adjacent columns. So this: $H$1 $B$1 $H$2 $B$2 $H$3 $B$3 $H$4 $B$4 $H$5 $B$5 $H$6 $B$6 $H$7 $B$7 aaaa $B$8 $H$9 $B$9 $H$10 $B$10 $H$11 $B$11 $H$12 $B$12 $H$13 $B$13 $H$14 $B$14 $H$15 $B$15 aaaa $B$16 $H$17 $B$17 $H$18 $B$18 $H$19 $B$19 $H$20 $B$20 $H$21 $B$21 $H$22 $B$22 aaaa $B$23 $H$24 $B$24 $H$25 $B$25 $H$26 $B$26 $H$27 $B$27 $H$28 $B$28 $H$29 $B$29 $H$30 $B$30 Would become (broken by aaaa in column A) this: $H$1 $B$1 aaaa $B$8 aaaa $B$16 aaaa $B$23 $H$2 $B$2 $H$9 $B$9 $H$17 $B$17 $H$24 $B$24 $H$3 $B$3 $H$10 $B$10 $H$18 $B$18 $H$25 $B$25 $H$4 $B$4 $H$11 $B$11 $H$19 $B$19 $H$26 $B$26 $H$5 $B$5 $H$12 $B$12 $H$20 $B$20 $H$27 $B$27 $H$6 $B$6 $H$13 $B$13 $H$21 $B$21 $H$28 $B$28 $H$7 $B$7 $H$14 $B$14 $H$22 $B$22 $H$29 $B$29 $H$15 $B$15 $H$30 $B$30 If that's close, try this against a copy of your worksheet. Option Explicit Sub testme01() Dim wks As Worksheet Dim myWord As String Dim FoundCell As Range Dim CountOfWords As Long Dim rngToCopy As Range Dim cCtr As Long Set wks = Worksheets("sheet1") 'What's the word???? myWord = "aaaa" cCtr = 0 With wks CountOfWords = Application.CountIf(.Range("a:a"), myWord) Do With .Range("a:a") Set FoundCell = .Cells.Find(what:=myWord, _ after:=.Cells(1), LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByRows, _ searchdirection:=xlPrevious, _ MatchCase:=False) End With If FoundCell Is Nothing Then 'we're done Exit Do End If Set rngToCopy = .Range(FoundCell, _ .Cells(.Rows.Count, "a").End(xlUp)) rngToCopy.Resize(, 2).Cut _ Destination:=.Cells(1, 2 * CountOfWords + 1 - cCtr) cCtr = cCtr + 2 Loop End With End Sub Rob wrote: I have 2 LONG columns that I need to make into MANY. I want to find a word in the active column, cut from that word down to the end and the adjacent cells; then paste them at the top of the next column. and do this for all occurences of that word. -- Dave Peterson |
#3
|
|||
|
|||
That is exactly what i want to do, but your code gave me an error at line:
rngToCopy.Resize(, 2).Cut _ Destination:=.Cells(1, 2 * CountOfWords + 1 - cCtr) I had already figured out a pretty easy way to do it in the meantime, but now i need the loop... as my code only does one instance at a time. here is what I had come up with: Sub FirstTry() Dim ObjKeyCell Dim X Dim Y Dim Z Set ObjKeyCell = Cells.Find(what:="Subject:", after:=ActiveCell, searchorder:=xlByColumns, searchdirection:=xlNext) Set X = ObjKeyCell Set Y = X.Next Set Z = Y.Next Range(X, Y).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Z.Select Selection.End(xlUp).Select ActiveSheet.Paste End Sub |
#4
|
|||
|
|||
That code worked ok for me. I started at the bottom and worked up. I thought
it would be easier. You may want to paste the code you used. (I suspect a change.) Rob wrote: That is exactly what i want to do, but your code gave me an error at line: rngToCopy.Resize(, 2).Cut _ Destination:=.Cells(1, 2 * CountOfWords + 1 - cCtr) I had already figured out a pretty easy way to do it in the meantime, but now i need the loop... as my code only does one instance at a time. here is what I had come up with: Sub FirstTry() Dim ObjKeyCell Dim X Dim Y Dim Z Set ObjKeyCell = Cells.Find(what:="Subject:", after:=ActiveCell, searchorder:=xlByColumns, searchdirection:=xlNext) Set X = ObjKeyCell Set Y = X.Next Set Z = Y.Next Range(X, Y).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Z.Select Selection.End(xlUp).Select ActiveSheet.Paste End Sub -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|