# Making 4 columns from 2 columns

#### rlnye

##### New Member
In Excel 2000, a spreadsheet I use extracts data in two columns (column A1 is numeric and B1 in descriptive text) the number of rows in the two columns varies...sometimes just 6 rows in the two columns othertimes 32 rows. What I need to do is if the number of rows in A1:B? is over 15, divide the number of rows in half and copy the bottom half to D1. In other words if the number of rows is A1:B24...copy the bottom 12 rows A13:B24 to D1. If I need to use VB code can someone help with the code...I'm a new comer to Excel. Thanks

### Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Try this:

Code:
``````Sub Test()
Dim Source As Range
Dim Target As Range
Dim RowCount As Long
Dim Half As Long
Set Source = Range("A1:B" & Range("A1").End(xlDown).Row)
If Source.Rows.Count <= 15 Then Exit Sub
Set Target = Range("D1")
RowCount = Source.Rows.Count
Half = Int(Source.Rows.Count / 2 + 0.5)
Set Source = Source.Offset(Half, 0).Resize(RowCount - Half)
Source.Cut Target
End Sub``````

Andrew, thanks for the VB code, it works great! I have a little problem that I created by inserting a few simple macro codes in with what you gave me. The problem is, if the number of rows is less than 15 the macro ends. What I need to do is have it make two rows if the number of rows are more than 15...which it does. Or, continue to run the other macro code if the number of rows is less than 15. Can you use some form of "loop?"

Thanks again for the help

Like this?

Code:
``````Sub Test()
Dim Source As Range
Dim Target As Range
Dim RowCount As Long
Dim Half As Long
Set Source = Range("A1:B" & Range("A1").End(xlDown).Row)
If Source.Rows.Count <= 15 Then
Set Target = Range("D1")
RowCount = Source.Rows.Count
Half = Int(Source.Rows.Count / 2 + 0.5)
Set Source = Source.Offset(Half, 0).Resize(RowCount - Half)
Source.Cut Target
End If
End Sub``````

Andrew, thank you very much...you have saved me many, many brain cells that I cannot afford to lose. It works great!

Thanks again.

Andrew, thank you very much...you have saved me many, many brain cells that I cannot afford to lose. It works great!

Thanks again.

Andrew, thank you very much...you have saved me many, many brain cells that I cannot afford to lose. It works great!

Thanks again.

Andrew, I guess I spoke to soon. I copied the complete macro below...what I really am trying to do is, if the number of rows is >=15 then make two rows, if it is <=15 run the macro code below the code you gave me. I hope this makes sense...thanks again.

Sub MakeFinalBidSheet()
'
' MakeFinalBidSheet Macro
' Macro recorded 9/11/2002 by Ronnie
'

Sheets("Sign WorkSheet & Bid Sheet").Range("B8:D141").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Sign WorkSheet & Bid Sheet").Range( _
"C4:C5"), CopyToRange:=Range("A1"), Unique:=False
Range("A1:D55").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft

Dim Source As Range
Dim Target As Range
Dim RowCount As Long
Dim Half As Long
Set Source = Range("A1:B40" & Range("A1").End(xlDown).Row)
If Source.Rows.Count <= 15 Then
Set Target = Range("E1")
RowCount = Source.Rows.Count
Half = Int(Source.Rows.Count / 2 + 0.5)
Set Source = Source.Offset(Half, 0).Resize(RowCount - Half)
Source.Cut Target
End If

Sheets("Legal Description").Select
ActiveWindow.ScrollRow = 1
Range("A22:A34").Select
Selection.Copy
Sheets("Bid Sheet WorkSheet").Select

Dim LastRow As Long
Dim NextRow As Long

' determine where the data ends on Column A Legal Description
Worksheets("Legal Description").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row

' copy the data from Column A in Legal Description Worksheet
Range("A22:A34").Copy

' Determine where to add the new data in Column A of Bid WorkSheet
Worksheets("Bid Sheet WorkSheet").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Offset(3, 0).Select
NextRow = ActiveCell.Row
ActiveSheet.Paste
Application.CutCopyMode = False

' paste the data to Column A Sign WorkSheet & Bid Sheet
' Worksheets("Bid Sheet WorkSheet").Range("A" & NextRow).Select
' ActiveSheet.Paste
' Application.CutCopyMode = False
' ActiveSheet.Paste

End Sub

Set Source = Range("A1:B40" & Range("A1").End(xlDown).Row)

should be

Set Source = Range("A1:B" & Range("A1").End(xlDown).Row)

Other than that, what isn't working?

Andrew, it makes two rows if the number of rows is 15 or less. What I need to do is make two rows only if there is 15 or more rows...and if less than or more than 15 rows, to continue to run the VB code under your code.

Thanks for taking the time to help.

Replies
7
Views
322
Replies
3
Views
230
Replies
6
Views
373
Replies
2
Views
510
Replies
4
Views
418

1,217,433
Messages
6,136,597
Members
450,021
Latest member
Jlopez0320

### 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.

### Which adblocker are you using?

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

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