Modifying an existing macro to work with two columns instead of one.

jamiemarie

Board Regular
Joined
Jun 24, 2020
Messages
67
Office Version
  1. 365
Platform
  1. Windows
Good Morning Experts,
I have the following macro that takes a long column of data and at row 47 cuts and pastes into the next column looping until there is no data left. It also keeps the original columns header and puts it in the first cell of every new column made. I thought I would be able to easily modify this, but I'm just not getting it. I now have a sheet that has two columns that I need to stop at row 47 and continue in the next two columns with the headers. Below is the macro and an example of what I have, and what result I want. Thanks in advance if anyone can help. Original macro credit goes to Tom Urtis of this board (I was able to modify to add the headers).

VBA Code:
Sub Split_Column()
' Keeps Header, ends column where print page stops

Application.ScreenUpdating = False
Dim LastRow&, NextRow&, NextColumn&
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
NextRow = 47
NextColumn = 2
Do
Range(Cells(NextRow, 1), Cells(NextRow + 46, 1)).Cut Cells(1, NextColumn)
NextRow = NextRow + 46
NextColumn = NextColumn + 1
Loop Until NextRow > LastRow
Application.ScreenUpdating = True

Range("B1").Select
    Selection.Cut
    Range(Selection, Selection.End(xlDown)).Select
    Range("A47").Select
    ActiveSheet.Paste
    Range("A1").Select
    Selection.Copy
    Range("B1:S1").Select
    ActiveSheet.Paste
End Sub

What I have:
MS CS Kit Inventory 7-23.xlsx
AB
1CS NumberQTY
2CS-0011822588
3CS-00137583539
4CS-0020204971
5CS-0019673067
6CS-0020185786
7CS-00201792140
8CS-0019836619
9CS-00196784101
10CS-0021137237
11CS-0019670067
12CS-00230747
13CS-002307838
14CS-002024962
15CS-00230807
16CS-0020184740
17CS-0020187943
18CS-002185113
19CS-0020213210
20CS-0020213310
21CS-001095446
22CS-0010926330
23CS-005372426
24CS-001093398
25CS-0010926223
26CS-001094351
27CS-001984331
28CS-0010926016
29CS-0010926127
30CS-0010925948
31CS-001990131
32CS-0350116
33CS-05374720
34CS-0011738430
35CS-002592281
36CS-002560471
37CS-002594001
38CS-002593932
39CS-002540521
40CS-002490741
41CS-002498981
42CS-002484241
43CS-002590481
44CS-002591151
45CS-002595071
46CS-002531131
47CS-002594181
48CS-0019931515
49CS-001365519
50CS-0013758424
51CS-001364443
52CS-00148036128
53CS-0019836814
54CS-001988872
55CS-001984025
56CS-0019843418
57CS-001375988
58CS-001374679
59CS-0019837121
60CS-001989112
61CS-001361461
62CS-001983743
63CS-0019846276
64CS-0013756263
65CS-0019841335
66CS-0013760321
67CS-0013662011
68CS-00178018219
69CS-0019857333
70CS-002307355
71CS-0019860433
72CS-00178124136
73CS-0019856411
74CS-0017806037
75CS-002113551
76CS-001779701
77CS-0019858015
78CS-00178122174
79CS-00177941124
80CS-002127701
81CS-002069634
82CS-00206605203
83CS-0020179135
84CS-0013785029
85CS-00199305115
86CS-00201870123
87CS-00207667157
88CS-00231173385
89CS-002066503
90CS-002065613
91CS-002060855
92CS-002058136
93CS-002068895
94CS-002018443
95CS-002061907
96CS-002059275
97CS-002070985
98CS-002066658
99CS-002073155
100CS-002058648
101CS-0020595711
102CS-002076905
103CS-002073516
104CS-0013747832
105CS-0019841041
106CS-001362513
107CS-001365823
108CS-001371013
109CS-001366463
110CS-001371663
111CS-001361332
112CS-001363806
113CS-001360882
114CS-0020188444
115CS-0020188168
116CS-002063765
117CS-0020596559
118CS-002067324
119CS-002066629
120CS-002067433
121CS-002059752
122CS-002076372
123CS-002058861
124CS-001366313
125CS-001373536
126CS-001359906
127CS-002118282
128CS-002130794
129CS-002144201
130CS-002142541
131CS-002112713
132CS-002119483
133CS-002114011
134CS-002114221
135CS-002114085
136CS-002117491
137CS-002113141
138CS-002116071
139CS-002115642
140CS-002244721
141CS-002240691
142CS-002124321
143CS-002131291
144CS-002112951
145CS-002240131
146CS-002113235
147CS-002114551
148CS-002115972
149CS-002114091
150CS-002113921
151CS-002113402
152CS-002114231
153CS-002118622
154CS-002113211
155CS-002114121
156CS-002115882
157CS-002117561
158CS-002113743
159CS-002115871
160CS-002113701
161CS-002138922
162CS-002114284
163CS-002136091
164CS-002120781
165CS-002115823
166CS-002131943
167CS-002135012
168CS-002130762
169CS-002142741
170CS-002128414
171CS-002120611
172CS-002137931
173CS-002121124
174CS-002136311
175CS-002125491
176CS-002118612
177CS-002128601
178CS-002123661
179CS-002117891
180CS-002126001
181CS-002119022
182CS-002018431
183CS-002129291
184CS-002131224
185CS-002120721
186CS-002141061
187CS-002129881
Sheet2


What result I would like:
MS CS Kit Inventory 7-23.xlsx
ABCDEFGH
1CS NumberQTYCS NumberQTYCS NumberQTYCS NumberQTY
2CS-0011822588CS-002594181CS-002058136CS-002113141
3CS-00137583539CS-0019931515CS-002068895CS-002116071
4CS-0020204971CS-001365519CS-002018443CS-002115642
5CS-0019673067CS-0013758424CS-002061907CS-002244721
6CS-0020185786CS-001364443CS-002059275CS-002240691
7CS-00201792140CS-00148036128CS-002070985CS-002124321
8CS-0019836619CS-0019836814CS-002066658CS-002131291
9CS-00196784101CS-001988872CS-002073155CS-002112951
10CS-0021137237CS-001984025CS-002058648CS-002240131
11CS-0019670067CS-0019843418CS-0020595711CS-002113235
12CS-00230747CS-001375988CS-002076905CS-002114551
13CS-002307838CS-001374679CS-002073516CS-002115972
14CS-002024962CS-0019837121CS-0013747832CS-002114091
15CS-00230807CS-001989112CS-0019841041CS-002113921
16CS-0020184740CS-001361461CS-001362513CS-002113402
17CS-0020187943CS-001983743CS-001365823CS-002114231
18CS-002185113CS-0019846276CS-001371013CS-002118622
19CS-0020213210CS-0013756263CS-001366463CS-002113211
20CS-0020213310CS-0019841335CS-001371663CS-002114121
21CS-001095446CS-0013760321CS-001361332CS-002115882
22CS-0010926330CS-0013662011CS-001363806CS-002117561
23CS-005372426CS-00178018219CS-001360882CS-002113743
24CS-001093398CS-0019857333CS-0020188444CS-002115871
25CS-0010926223CS-002307355CS-0020188168CS-002113701
26CS-001094351CS-0019860433CS-002063765CS-002138922
27CS-001984331CS-00178124136CS-0020596559CS-002114284
28CS-0010926016CS-0019856411CS-002067324CS-002136091
29CS-0010926127CS-0017806037CS-002066629CS-002120781
30CS-0010925948CS-002113551CS-002067433CS-002115823
31CS-001990131CS-001779701CS-002059752CS-002131943
32CS-0350116CS-0019858015CS-002076372CS-002135012
33CS-05374720CS-00178122174CS-002058861CS-002130762
34CS-0011738430CS-00177941124CS-001366313CS-002142741
35CS-002592281CS-002127701CS-001373536CS-002128414
36CS-002560471CS-002069634CS-001359906CS-002120611
37CS-002594001CS-00206605203CS-002118282CS-002137931
38CS-002593932CS-0020179135CS-002130794CS-002121124
39CS-002540521CS-0013785029CS-002144201CS-002136311
40CS-002490741CS-00199305115CS-002142541CS-002125491
41CS-002498981CS-00201870123CS-002112713CS-002118612
42CS-002484241CS-00207667157CS-002119483CS-002128601
43CS-002590481CS-00231173385CS-002114011CS-002123661
44CS-002591151CS-002066503CS-002114221CS-002117891
45CS-002595071CS-002065613CS-002114085CS-002126001
46CS-002531131CS-002060855CS-002117491CS-002119022
47
48CS NumberQTY
49CS-002018431
50CS-002129291
51CS-002131224
52CS-002120721
53CS-002141061
54CS-002129881
Sheet2
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
How about
VBA Code:
Sub jamiemarie()
   Dim i As Long, j As Long
   
   j = 3
   For i = 48 To Range("A" & Rows.Count).End(xlUp).Row Step 46
      Cells(i, 1).Resize(46, 2).Copy Cells(2, j)
      j = j + 2
   Next i
   Range("A1:B1").Copy Range("C1").Resize(, j - 3)
   Rows("48:" & Rows.Count).ClearContents
End Sub
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,214,998
Messages
6,122,638
Members
449,093
Latest member
Ahmad123098

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top