Pulling Apart Rows - Part 2

**paul_20k** · 10-01-2006, 03:15 PM

Hi Everyone

I am unable to attach excel file as its more than filesize limit...

I sent one post before this one about pulling apart rows. I am looking for some more help regarding that macro. I attached an excel sheet with test data and macro. I am trying to use that macro on the whole column but I am unable to do that. Please take a look at the macro. Any help would be appreciated.

About macro - my macro is working fine when I select 3 rows but doesn't work when I select whole column. If you will look at the macro, you will understand it better. Just select B6, B7, B8 and run macro..it works fine according to expectaions but it splits and copies the last cell in the selected cells. I tried all options but I am unable to copy the rest of the cells on the newly created sheet.

For m = 0 To ThisCol
For j = 0 To 3
strArray = Split(Sheets(1).Cells(ThisRow + m, ThisCol).Value, vbLf)
MsgBox strArray(j)

Next j
Next m

in the section of the macro, you can see that array has all the cell info. But I am unable to see the same array output on the new sheet.

Thanks so much..I would really appreciate your help.

Note - Please select rows B6, B7, B8 and run macro to see the result.

Sub experiment()
Dim strArray() As String
Dim ThisRow As Integer
Dim ThisCol As Integer
Dim j As Integer
Dim m As Integer
Dim ws As Worksheet 'Create a worksheet object

ThisRow = ActiveWindow.RangeSelection.Row
ThisCol = ActiveWindow.RangeSelection.Column

j = ThisRow

For m = 0 To ThisCol
For j = 0 To 3
strArray = Split(Sheets(1).Cells(ThisRow + m, ThisCol).Value, vbLf)
MsgBox strArray(j)

Next j
Next m

Set ws = Sheets.Add 'set worksheet Object to new sheet
ws.Name = "New Input Data" 'rename sheet

For i = 0 To UBound(strArray)
Sheets("New Input Data").Cells(ThisRow + i, 1).Value = strArray(i)
Columns("A:A").EntireColumn.AutoFit
'MsgBox i
'MsgBox ThisRow + i
'MsgBox strArray(i)
'MsgBox UBound(strArray)
'MsgBox ThisCol
Next i

End Sub