Logo Hardware.com.br
lucasjazevedo
lucasjazeved... Novo Membro Registrado
2 Mensagens 1 Curtida

Macro para selecionar uma planilha, copiar e colar valores em outra planilha (consolidada).

#1 Por lucasjazeved... 19/03/2018 - 15:59
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
osvaldomp
osvaldomp Geek Registrado
753 Mensagens 558 Curtidas
#2 Por osvaldomp
19/03/2018 - 16:46
Experimente:

substitua estas linhas
'Seleciona a planilha
ActiveWorkbook.Sheets("PLANO DE AÇÃO&quot.Select
'Descubro sua quantas linhas ele possui
rTemp = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "J&quot.End(xlUp).Row
'atualiza última linha da planilha padrão
r = shPadrao.Cells(Rows.Count, "I&quot.End(xlUp).Row
'Copio e colo na planilha principal
If ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "J&quot.End(xlUp).Row > 6 Then
ActiveWorkbook.ActiveSheet.Range("B7:R" & rTemp).Copy shPadrao.Range("A" & r + 1)
Else
ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "J&quot.End(xlUp).Select
End If

por estas
With ActiveWorkbook.Sheets("PLANO DE AÇÃO&quot
'Descubro sua quantas linhas ele possui
rTemp = .Cells(Rows.Count, "J&quot.End(xlUp).Row
'Copio e colo na planilha principal
If rTemp > 6 Then
.Range("B7:R" & rTemp).Copy
shPadrao.Range("A" & r + 1).PasteSpecial xlPasteValues
End If
End With
Osvaldo
© 1999-2024 Hardware.com.br. Todos os direitos reservados.
Imagem do Modal