Olá,
Sou novo por aqui, mas não encontrei outro tópico com solução que funcione para o meu caso.
Tenho uma planilha base que consolida dados de outros mais de 100 arquivos. Usei vários códigos que encontrei na net para montar um que faça a busca pelos arquivos e copie os dados na sequência, até aí tudo funciona. Porém não consigo copiar apenas os valores das células (PasteSpecial) e acabo copiando as fórmulas e formatação com este código.
Alguém sabe como posso copiar somente valores neste código, lembrando que abro uma planilha para copiar e colo em outra já aberta, porém há um loop para continuar fazendo isto com os demais arquivos.
Segue o meu código:
Sub Importar_XLS()
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
.Calculation = xlManual
End With
'Chamar macro para limpar as células
Call Limpar
'A planilha onde serão colados os dados
Set shPadrao = Sheets("Base Consolidado")
'O caminho onde as planilhas que serão lidas estao
sPath = "S:\PLANO DE ACAO - 2018\00CONSOLIDADO\PLANO DE AÇÃO_não editar_\"
'Descubro o nome do primeiro arquivo a ser aberto
sName = Dir(sPath & "*.xls*")
'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
'Abro o workbook a ser lido
Workbooks.Open filename:=fName, UpdateLinks:=False
'Seleciona a planilha
ActiveWorkbook.Sheets("PLANO DE AÇÃO").Select
'Descubro sua quantas linhas ele possui
rTemp = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
'atualiza última linha da planilha padrão
r = shPadrao.Cells(Rows.Count, "I").End(xlUp).Row
'Copio e colo na planilha principal
If ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row > 6 Then
ActiveWorkbook.ActiveSheet.Range("B7:R" & rTemp).Copy shPadrao.Range("A" & r + 1)
Else
ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Select
End If
'Fecha a pasta de trabalho copiada
Workbooks(sName).Close SaveChanges:=False
ScapeB:
'Atualizo a variavel com funcao DIR() que acha o proximo arquivo nao processado
sName = Dir()
Loop
On Error GoTo 0
Call Planilha2.Reexibir
Call RefreshPivotTables
Call Planilha2.Ocultar
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlAutomatic
End With
'Mensagem de conclusão
MsgBox "Planilha Atualizada com sucesso."
End Sub
lucasjazeved...
Novo Membro
Registrado
2 Mensagens
1 Curtida