Paste Data into other row

T

TomBP

Hi everyone

I have the following problem. As you can see in the picture below
have 2 columns.

[image: http://i54.photobucket.com/albums/g115/TomBP/Town.jpg]

Now what I want my macro to do is what you see in the next picture:

[image: http://i54.photobucket.com/albums/g115/TomBP/Postal.jpg]

There is a colum that has been inserted. In this column, which is name
Postal, the postal codes from the previous town column are pasted.

Now the hard part is that the postal codes aren't always numbers. The
can look like CH542 aswell. The only thing that is the same for th
town column is that there is a space between the town and the posta
code.

I hope you understand what I mean and thanks in advance
 
J

Jim Jackson

Sub splitColumns()
Columns("E").Select
Selection.Insert Shift:=xlToRight
For each sell in sheets
Do
If activecell = "" then
end sub
else
end if
Range("D9").Activate
x = InStr(ActiveCell, " ")

ActiveCell.Offset(0, 1) = Mid(ActiveCell.Offset(0, 0), x, 8)
Activecell.offset(1,0)
Loop while activecell <> ""
Next
End Sub
 
J

Jim Jackson

My BAD!

The "End Sub" after the "If - Else" should be "Exit Sub". I typed this out
instead of copying from actual code which I should have done.

Sorry about that.
 
J

Jim Jackson

I must have been half asleep when I sent the original reply. Add .Activate
to the end of that and it will work.

Sorry again.
 
T

TomBP

The macro works now but it doesn't do what I had in mind. It justs
inserts a column. The thing I wanted extra was that the postal codes in
the town column would be cut and pasted into the inserted column.

Thx for your time tho
 
J

Jim Jackson

Tom,

This routine will do what you need. Just change cell references as needed.

Sub splitColumns()
' Inserts the column
Sheets("Sheet1").Select
ActiveSheet.Columns("E").Select
Selection.Insert Shift:=xlToRight
ActiveCell.Offset(0, -1).Activate

'Moves the mail code
For Each cell In Sheets
Do
If ActiveCell = "" Then
Exit Sub
Else
End If
x = InStr(ActiveCell, " ")
ActiveCell.Offset(0, 1) = Mid(ActiveCell.Offset(0, 0), x, 8)
ActiveCell = Mid(ActiveCell, 1, x)
ActiveCell.Offset(1, 0).Activate
Loop While ActiveCell <> ""
Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top