alteração de código...
 
Notifications
Clear all

alteração de código de macro existente

3 Posts
2 Usuários
0 Reactions
917 Visualizações
(@kayomaster)
Posts: 90
Trusted Member
Topic starter
 

Olá gente eu tenho o código abaixo que ele precisa continuar fazendo o que faz, copiar as celulas e colar nas planilhas. porém as mesmas células que serão copiadas elas tem código e nesse caso ele vai copiar o valor que tiver aparecendo se for diferente de zero. ja tentei varias vezes e nao consegui fazer a mudança. por ter código na celula ele acaba copiando o codigo mesmo quando tem zero ou numeros nele e ele só copia a formula e não o valor informado =/.
eu ainda consegui trocar o 'Verificamos se o avlor é nulo
If i.Value <> "" Then tirei as aspas puz 0 mas não fez o esperado. comparei com outra que tinha aqui mas nao deu certo.

Sub Copy_Consolidado()
    Dim Linha As Long
    Dim sLinSheets As Long
    Dim sRG As Range
    Dim sCodigo
    Dim sRow As Long
    Dim sSht As Worksheet
    Dim ShtCONSOLIDADO As Worksheet
    Dim sRgColunas
    Dim sRotulo
    Dim iLinRotulo
    Dim Col As String
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Set ShtCONSOLIDADO = wb.Sheets("CONSOLIDADO")
    
    Linha = ShtCONSOLIDADO.Range("A2").End(xlDown).Row
    
    Set sRG = ShtCONSOLIDADO.Range("A4:" & "A" & Linha)
    
        For Each x In sRG
            sRow = x.Row

            Set sRgColunas = ShtCONSOLIDADO.Range("C" & sRow & ", I" & sRow & ",M" & sRow & ", O" & sRow & ",R" & sRow & ", T" & sRow & ",V" & sRow)
                
                For Each i In sRgColunas
                    iLinRotulo = 2 'Linha do Cabeçalho
                    
                    'Verificamos se o avlor é nulo
                    If i.Value <> "" Then
                        'Montamos a Letra das Colunas
                        Col = Split(i.Address(1, 0), "$")(0)
                        
                        'Linha dos Rotulos (Cabeçalho)
                        sRotulo = Range(Col & iLinRotulo).Address(0, 0)
                        'Capturamos o codigo
                        sCodigo = x.Value
                        sRow = i.Row
                        
                        'Montamos o nome da aba como o sCodigo
                        Set sSht = wb.Sheets(CStr(sCodigo))
                        sLinSheets = sSht.Range("A2").End(xlDown).Row + 1
                        
                        'Copiamos para as abas
                        ShtCONSOLIDADO.Range(sRotulo).Copy Destination:=sSht.Range("A" & sLinSheets)
                        ShtCONSOLIDADO.Range(i.Address).Copy Destination:=sSht.Range("B" & sLinSheets)
                        'Na instrução abaixo estou supondo que a data que comentou seria da Coluna L -DATA ENVIO
                        'Se não for, é só ajustar
                        ShtCONSOLIDADO.Range("AA" & sRow).Copy Destination:=sSht.Range("C" & sLinSheets)
                     End If
                     
                 Next i
        Next

End Sub
 
Postado : 01/04/2018 8:35 pm
(@klarc28)
Posts: 971
Prominent Member
 

Olá, Kayo. Está bem de saúde?

ShtCONSOLIDADO.Range(sRotulo).Copy 
sSht.Range("A" & sLinSheets).PasteSpecial (xlPasteValues)
                        ShtCONSOLIDADO.Range(i.Address).Copy 
sSht.Range("B" & sLinSheets).PasteSpecial (xlPasteValues)
 
Postado : 01/04/2018 8:58 pm
(@kayomaster)
Posts: 90
Trusted Member
Topic starter
 

ola muito obrigado deu certo.

Estou melhorando sim graças a Deus. Apesar de haver alguns desafios ainda a frente. muito obrigado pela lembrança. forte abraço.

 
Postado : 01/04/2018 9:53 pm