How to keep same structure of newly created cells from old cells.

[Nishu]

Hello,
I have attached file where code breaks the cell in to row if symbol found in cell, but it destroy the structure of data.
i want the result as per the attached.(that mean if cell have color in this case new created rows cell also have the same color)
please suggest what changes are require in code.

 

[Marc L]

Hi,

just use Range.Copy method to keep cell formatting …​

 

[Nishu]

Hi Mark,
I have tried Range.copy, but not getting the result.

Please suggest or have a look the code.

 

[Marc L]

Please do not quote a whole just previous post, it's just clutter, thanks !

As Range.Copy is the direct method …
Another way is Paste / PasteSpecial methods as you can see in VBA help.

As your actual code was made to not keep any formatting …
​

 

[Nishu]

Hi,
Could you please let me where i have to use Range.Copy.

 

[Marc L]

I have tried Range.copy, but not getting the result.

Can you elaborate ? Wanna see the code …
​

 

[Nishu]

Can you elaborate ? Wanna see the code …
​

Hi Sir,
Please find the below code, Please assist.


Sub Demo()
Dim arO, resAr(), i As Long, j As Long, k As Long
Dim rcol As New Collection
arO = Range("A2:G" & Cells(Rows.Count, 1).End(xlUp).Row).Value2

For i = 1 To UBound(arO)
If InStr(arO(i, 1), ",") Then
x = Split(arO(i, 1), ",")
ElseIf InStr(arO(i, 1), "/") Then
x = Split(arO(i, 1), "/")
Else
x = Array(arO(i, 1))
End If

For j = 0 To UBound(x)
If InStr(arO(i, 2), ",") Then
y = Split(arO(i, 2), ",")
ElseIf InStr(arO(i, 2), "/") Then
y = Split(arO(i, 2), "/")
Else
y = Array(arO(i, 2))
End If
For k = 0 To UBound(y)
Debug.Print Trim(x(j)) & "|" & Trim(y(k)) & "|" & arO(i, 3) & "|" & arO(i, 4) & "|" & arO(i, 5) & "|" & arO(i, 6)
rcol.Add Trim(x(j)) & "|" & Trim(y(k)) & "|" & arO(i, 3) & "|" & arO(i, 4) & "|" & arO(i, 5) & "|" & arO(i, 6) & "|" & arO(i, 7)


Next
Next
Next

ReDim resAr(1 To rcol.Count, 1 To 7)

Range.Select
Range.Copy

For i = 1 To rcol.Count
x = Split(rcol(i), "|")
For j = 0 To UBound(x)
resAr(i, j + 1) = x(j)
Next
Next


Range("J1").Resize(1, 7).Value = Range("A1:G1").Value
Range("J2").Resize(UBound(resAr), 7) = resAr
Range("J:J").Resize(, 7).Columns.AutoFit
End Sub

 

[Marc L]

1) you forgot code tags as per forum rules !

2) There is no Range.Copy in this code ‼ See post #6 …​

 

[Nishu]

1) you forgot code tags as per forum rules !

2) There is no Range.Copy in this code ‼ See post #6 …​

Hi Sir,
Seriously i don't know how to use range.copy method in this code, if possible please suggest what changes need to do in the code.

Thank you

 

[Marc L]

As you wrote

I have tried Range.copy, but not getting the result.

so I asked to see your try ! …

Instead of DestinationRange.Value = SourceRange.Value in your code
use SourceRange.Copy DestinationRange.
(As DestinationRange can be the upper left destination cell only …)
​