VBA Help find and then incert

[justme1122]

Hi guys

Trying to work out how to do the following:

I want to find the headers and then move it and everything under it to the right one colum, ie: change this:

Excel Workbook
	A	B	C	D
5	Stock
6	Accessories
7	Blank Tapes
8	Chips
9	Confectionery
10	Disk Repair/Cleaning
11	Drinks
12	Ice Creams
13	Member Admin Fees
14	Misc Food Items
15	Miscellaneous items
16	News/Mags/Books
17	Popcorn
18	Promo Merchandise
19	Virgin Accessories
20	Vouchers
21	Subtotal
22	Ex-rental
23	Game, Nintendo Wii
24	Game, PlayStation 2
25	Game, Playstation 3
26	Game, X-Box
27	Game, X-Box 360
28	Movie, Blu-Ray
29	Movie, DVD
30	TV, DVD
31	Subtotal
32	Rental
33	Accessories, Nintendo Wii
34	Game, Nintendo Wii
35	Game, PlayStation 2
36	Game, Playstation 3
37	Game, X-Box
38	Game, X-Box 360
39	Movie, Blu-Ray
40	Movie, DVD
41	TV, DVD
42	Subtotal
43	Sell Through
44	Accessories, PC Compatible
45	Game, DreamCast
46	Game, Nintendo Wii
47	Game, PC compatible
48	Game, PlayStation 2
49	Game, Playstation 3
50	Game, X-Box 360
51	Movie, Blu-Ray
52	Movie, DVD
53	Movie, DVD - Vanilla
54	TV, Blu-Ray
55	TV, DVD
56	Subtotal
Sheet

to this

Excel Workbook
	A	B	C	D
5	Stock
6	Accessories
7	Blank Tapes
8	Chips
9	Confectionery
10	Disk Repair/Cleaning
11	Drinks
12	Ice Creams
13	Member Admin Fees
14	Misc Food Items
15	Miscellaneous items
16	News/Mags/Books
17	Popcorn
18	Promo Merchandise
19	Virgin Accessories
20	Vouchers
21	Subtotal
22		Ex-rental
23		Game, Nintendo Wii
24		Game, PlayStation 2
25		Game, Playstation 3
26		Game, X-Box
27		Game, X-Box 360
28		Movie, Blu-Ray
29		Movie, DVD
30		TV, DVD
31		Subtotal
32			Rental
33			Accessories, Nintendo Wii
34			Game, Nintendo Wii
35			Game, PlayStation 2
36			Game, Playstation 3
37			Game, X-Box
38			Game, X-Box 360
39			Movie, Blu-Ray
40			Movie, DVD
41			TV, DVD
42			Subtotal
43				Sell Through
44				Accessories, PC Compatible
45				Game, DreamCast
46				Game, Nintendo Wii
47				Game, PC compatible
48				Game, PlayStation 2
49				Game, Playstation 3
50				Game, X-Box 360
51				Movie, Blu-Ray
52				Movie, DVD
53				Movie, DVD - Vanilla
54				TV, Blu-Ray
55				TV, DVD
56				Subtotal
Sheet

Please note that this would be put into a loop and ran over a few hundred imported sheets. The Bold headers have constant names but not a constant cell location. The number of sub heading changes with each sheet.

On second thought there may be an easyer way to achive what im trying to do, is there a way to tell excell to:

=vlookup("drinks",between "STOCK" and the next "subtotal",m,0)


Thanks
so much for your time?

 

[AlphaFrog]

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Shift_Data()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> Found <SPAN style="color:#00007F">As</SPAN> Range, col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, Lastrow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> Worksheets<br>        col = 1<br>        <SPAN style="color:#00007F">Set</SPAN> Found = ws.Columns(col).Find("SubTotal", , xlValues, xlWhole, xlByRows, xlNext, <SPAN style="color:#00007F">False</SPAN>)<br>        <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Found <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>            Lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row<br>            <SPAN style="color:#00007F">If</SPAN> Found.Row <> Lastrow <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">Do</SPAN><br>                    ws.Range(Found.Offset(1), ws.Cells(Lastrow, col)).Insert Shift:=xlToRight<br>                    col = col + 1<br>                    <SPAN style="color:#00007F">Set</SPAN> Found = ws.Columns(col).Find("SubTotal")<br>                <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">Until</SPAN> Found.Row = Lastrow<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> ws<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[justme1122]

Thank you so much for your time

this did the job