Splitting a long row into small multiple rows

[sunilrd99]

Hello,

I have a excel data like A1,A2,A3............A99 IN THE RESP. CELLS of row 1.

What i need to do is split this row in to multiple rows containing data as below.
Row1: A1,A2,A3
Row2: A1,A2,A4
Row3: A1,A2,A5
Row4 A1,A2,A6

(A1 and A2 being constant. information, need to be duplicated in each row)

Can any body help me. Thanks in advance to the attempter!

 

[Rick Rothstein]

I think this macro does what you want...

Sub SplitDataDownward()
  Dim ACell As String, Common As String, Joined As String, Parts() As String
  ACell = Range("A1").Value
  Parts = Split(ACell, ",", 3)
  Common = Parts(0) & "," & Parts(1) & ","
  Parts = Split(Parts(2), ",")
  Joined = Common & Join(Parts, Chr(1) & Common)
  Parts = Split(Joined, Chr(1))
  Range("A1").Resize(UBound(Parts) + 1) = WorksheetFunction.Transpose(Parts)
End Sub

 

[Rick Rothstein]

I just reread your question and think I may have misinterpretted originally. I thought you had your A1,A2,A3,etc. all in A1, but in rereading your posting, I think you have A1 in cell A1, A2 in cell B1, A3 in cell C1, etc. If that is the case, then give this macro a try...

Sub SplitDataDownward()
  Dim ACell As String, Common As String, Joined As String, Parts() As String
  With WorksheetFunction
    ACell = .Trim(Join(.Index(Range(Cells(1, "A"), Cells(1, 1).End(xlToRight)).Value, 1, 0), ","))
    Rows(1).ClearContents
  End With
  Parts = Split(ACell, ",", 3)
  Common = Parts(0) & "," & Parts(1) & ","
  Parts = Split(Parts(2), ",")
  Joined = Common & Join(Parts, Chr(1) & Common)
  Parts = Split(Joined, Chr(1))
  Range("A1").Resize(UBound(Parts) + 1) = WorksheetFunction.Transpose(Parts)
End Sub

 

[sunilrd99]

Thanks Rick, I would definitely try and let u know.