Ir ao conteúdo
  • Cadastre-se

Copiar e Colar somente valores (VBA Excel)


Posts recomendados

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
 

 

Link para o comentário
Compartilhar em outros sites

Experimente inverter as posições dos comandos. Substitua esta linha

ActiveWorkbook.ActiveSheet.Range("C10").Copy shPadrao.Range("A" & r + 1)

por esta

shPadrao.Range("A" & r + 1) = ActiveWorkbook.ActiveSheet.Range("C10")

se essa alteração resolver, aplique às demais linhas com comandos similares
 

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novas respostas.

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

×
×
  • Criar novo...