Este fórum está sendo desativado

[Angra]

Boa tarde
Queria juntar vários valores em colunas diferentes e concatenar todos em uma unica coluna mas sem alterar a cor da fonte

[babdallas]

Código: Selecionar todos

Public Sub Concatenar()
    Dim rngOrig1 As Range
    Dim rngDest1 As Range
    Dim rngLin As Range, rngCel As Range
    Dim bytCont As Byte, lngColor As Long
    
    With Plan1
        Set rngOrig1 = .Range("U9:Y35")
        Set rngOrig2 = .Range("AA9:AE35")
        
        .Range("H9:K35").ClearContents
        For Each rngLin In rngOrig1.Rows
            bytCont = 0
            For Each rngCel In rngLin.Cells
                If rngCel.Value = "x" Then
                    bytCont = bytCont + 1
                    lngColor = rngCel.Font.Color
                End If
            Next rngCel
            If bytCont > 0 Then
                .Cells(rngLin.Row, 8).Value2 = "x"
                .Cells(rngLin.Row, 8).Font.Color = lngColor
            End If
        Next rngLin
        
        For Each rngLin In rngOrig2.Rows
            bytCont = 0
            For Each rngCel In rngLin.Cells
                If rngCel.Value = "x" Then
                    bytCont = bytCont + 1
                    lngColor = rngCel.Font.Color
                End If
            Next rngCel
            If bytCont > 0 Then
                .Cells(rngLin.Row, 11).Value2 = "x"
                .Cells(rngLin.Row, 11).Font.Color = lngColor
            End If
        Next rngLin
    End With
End Sub

[Angra]

Resposta a jato merece uma resposta turbo: Brigadassssssso