Create new row and copy

A

Annette

I have data that I split into columns that are referrals needing to be
reformatted ... row 1 is two different pieces of information that need to be
split. The information from colA, C, D, E, G H is going to be one row and
the information from colB, C, D, F, G, H has to be the new row.

The same is true for all the rows .. each row will be split into new ones
and I'll end up with a total of 6 rows when I'm finished.

colA colB colC colD ColE ColF ColG ColH
ralph gina date number action1 action2 junk junk
jo george date number action1 action2 junk junk
harriet sam date number action1 action2 junk junk


What I want to see in the end is:

colA colB colC colD ColE ColF
ralph date number action1 junk junk
gina date number action2 junk junk
jo date number action1 junk junk
george date number action2 junk junk
harriet date number action1 junk junk
sam date number action2 junk junk


How can I write this to do all of this? I'm at a loss.
 
F

Frank Kabel

Hi
try the following macro (change the target sheet name)

Sub transform_data()
Dim source_wks As Worksheet
Dim target_wks As Worksheet
Dim lastrow As Long
Dim row_index As Long
Dim target_row As Long
Dim col_index As Integer

Set source_wks = ActiveSheet
Set target_wks = Worksheets("sheet_target") 'change this line

target_row = 1
lastrow = source_wks.Cells(Rows.count, "A").End(xlUp).row
For row_index = 1 To lastrow
With target_wks.Cells(target_row, "A")
.Value = source_wks.Cells(row_index, "A").Value
.Offset(0, 1).Value = source_wks.Cells(row_index, "C").Value
.Offset(0, 2).Value = source_wks.Cells(row_index, "D").Value
.Offset(0, 3).Value = source_wks.Cells(row_index, "E").Value
.Offset(0, 4).Value = source_wks.Cells(row_index, "G").Value
.Offset(0, 5).Value = source_wks.Cells(row_index, "H").Value

.Offset(1, 0).Value = source_wks.Cells(row_index, "B").Value
.Offset(1, 1).Value = source_wks.Cells(row_index, "C").Value
.Offset(1, 2).Value = source_wks.Cells(row_index, "D").Value
.Offset(1, 3).Value = source_wks.Cells(row_index, "F").Value
.Offset(1, 4).Value = source_wks.Cells(row_index, "G").Value
.Offset(1, 5).Value = source_wks.Cells(row_index, "H").Value
End With

target_row = target_row + 2
Next
End Sub
 
A

Annette

Wow ... this is really cool and works perfectly ... thanks! Now on to the
next step!
 

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