Ir ao conteúdo
  • Cadastre-se

IGOR_PS

Membro Júnior
 Perfil  Explorar Conteúdo

  • Posts

    1

  • Cadastrado em

  • Última visita

 Tipo de conteúdo 

posts postados por IGOR_PS

    Copiar e Colar somente valores (VBA Excel)

    em Microsoft Office e similares

    Postado

    Boa noite! 

    Estou com um simples problema a ser resolvido: copiar e colar especial "somente valores". Já tentei utilizar a função " Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False" mas não dá certo na macro abaixo:

     

    Private Sub CommandButton1_Click()
     
    Dim sPath As String, sName As String, fName As String
    Dim r As Long, rTemp As Long
    Dim shPadrao As Worksheet
     
    'Para a macro executar mais rápido!
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
     
    'A planilha onde serão colados os dados
    Set shPadrao = Sheets("BASE")
     
    'O caminho onde as planilhas que serão lidas estão
    sPath = "F:\CARGA\TESTE\"
     
    'Descubro o nome do primeiro arquivo a ser aberto
    sName = Dir(sPath & "*.xl*")
     
    'Faço o loop que le todos os arquivos
    Do While sName <> ""
        
        'Acha a ultima linha utilizada na planilha onde serao colados os dados
        r = shPadrao.Cells(Rows.Count, "A").End(xlUp).Row
        
        'O caminho + o nome do arquivo a ser aberto
        fName = sPath & sName
        
        'Abrir o workbook a ser lido
        Workbooks.Open Filename:=fName, UpdateLinks:=False
        
            
        'Cola na planilha principal
        
        ActiveWorkbook.ActiveSheet.Range("C10").Copy shPadrao.Range("A" & r + 1)
        ActiveWorkbook.ActiveSheet.Range("F54").Copy shPadrao.Range("B" & r + 1)
        ActiveWorkbook.ActiveSheet.Range("L54").Copy shPadrao.Range("I" & r + 1)
        
        
        ActiveWorkbook.ActiveSheet.Range("C10").Copy shPadrao.Range("A" & r + 2)
        ActiveWorkbook.ActiveSheet.Range("F55").Copy shPadrao.Range("B" & r + 2)
        ActiveWorkbook.ActiveSheet.Range("L55").Copy shPadrao.Range("I" & r + 2)
           
        
        'Fecho o arquivo já lido
        ActiveWorkbook.Close SaveChanges:=False
        
    ScapeB:
        
        'Atualizo a variavel com funcao DIR() que acha o proximo arquivo nao processado
        sName = Dir()
        
    Loop
     
    On Error GoTo 0
     
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
     
    End Sub
     

     

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...

 

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!