Modify this VBA so it maintain hyperlinks?

[joelpe]

Hi,

I have a worksheet that has two columns: A and B, both with text

In column B there are some cells with more than one line, and i have found this VBA to separate them into several rows (pasting the data into a new sheet), and it works well.

However, the texts of column A have hyperlinks, and this VBA does not maintain them (or the color and other format,but I dont care about that). I dont understand much about the code used in VBA, so, could you add (if its possible, I dont even know if it can be done) some lines in this code so when I use the VBA it maintains the column A´s cells´ hyperlinks when pasting them in the new sheet?


Here is the VBA:

Sub CellSplitter()
    Dim Temp As Variant
    Dim CText As String
    Dim J As Integer
    Dim K As Integer
    Dim L As Integer
    Dim iColumn As Integer
    Dim lNumCols As Long
    Dim lNumRows As Long


    iColumn = 2


    Set wksSource = ActiveSheet
    Set wksNew = Worksheets.Add


    iTargetRow = 0
    With wksSource
        lNumCols = .Range("IV1").End(xlToLeft).Column
        lNumRows = .Range("A65536").End(xlUp).Row
        For J = 1 To lNumRows
            CText = .Cells(J, iColumn).Value
            Temp = Split(CText, Chr(10))
            For K = 0 To UBound(Temp)
                iTargetRow = iTargetRow + 1
                For L = 1 To lNumCols
                    If L <> iColumn Then
                        wksNew.Cells(iTargetRow, L) _
                          = .Cells(J, L)
                    Else
                        wksNew.Cells(iTargetRow, L) _
                          = Temp(K)
                    End If
                Next L
            Next K
        Next J
    End With
End Sub

Thank you

 

[Fluff]

Re: How to modify this VBA so it maintain hyperlinks?

Maybe

If l <> iColumn Then
   .Cells(j, l).Copy wksNew.Cells(iTargetRow, l)
Else
   wksNew.Cells(iTargetRow, l) = Temp(k)
End If

 

[joelpe]

Re: How to modify this VBA so it maintain hyperlinks?

Maybe

If l <> iColumn Then
   .Cells(j, l).Copy wksNew.Cells(iTargetRow, l)
Else
   wksNew.Cells(iTargetRow, l) = Temp(k)
End If

I tried to insert this on the code, but it always said that there were some problem and didnt work. However,maybe its my fault,because I dont know exactly where I have to insert it xD (I insert it at the end and then, when it didnt work, above "iTarjetRow=0")

Anyway, Thanks for the reply

 

[Fluff]

Re: How to modify this VBA so it maintain hyperlinks?

Replace this part of your code

                    If L <> iColumn Then
                        wksNew.Cells(iTargetRow, L) _
                          = .Cells(J, L)
                    Else
                        wksNew.Cells(iTargetRow, L) _
                          = Temp(K)
                    End If

with the code I supplied

 

[joelpe]

Re: How to modify this VBA so it maintain hyperlinks?

Oh okay, it seems pretty obvious xD

I tried it and works perfectly, thank you so much!

 

[Fluff]

Re: How to modify this VBA so it maintain hyperlinks?

Glad to help & thanks for the feedback