2
I’m trying to gather data from multiple files into a single spreadsheet. In some researches I did through the network, I found several suggestions, and below this the code I found and met the need. I made some adjustments to adapt to what I needed but I’m having a problem at the time of pasting the data in the destination.
I need "Special Glue" so that in the cells that contained formulas results, the value that was in the formula is pasted.
I tried several ways to use a ". Pastespecial Paste:=xlPasteValues" of life, but always error in the code of the line below:
'Colo na planilha principal
ActiveWorkbook.ActiveSheet.Range("A2:BA" & rTemp).Copy shPadrao.Range("B" & r)
Follows full code:
Sub Importar_XLS()
Dim sPath As String, sName As String, fName As String
Dim r As Long, rTemp As Long, r2 As Long, n 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("Dados")
'O caminho onde as planilhas estão salvas
sPath = "CaminhoDaPasta\"
'Descubro o nome do primeiro arquivo a ser aberto
sName = Dir(sPath & "*.xl*")
' Apagar o conteudo antes de copiar
shPadrao.Range("A2:BA104857").EntireRow.Delete
'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, "B").End(xlUp).Row
shPadrao.Range("A" & r).Value = sName
'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 que eu quero copiar
ActiveWorkbook.Sheets("Calculo_Consolidado").Select
Range("A2").Select
'Descubro quantas linhas ele possui
rTemp = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'Colo na planilha principal
ActiveWorkbook.ActiveSheet.Range("A2:BA" & rTemp).Copy shPadrao.Range("B" & r)
r2 = (shPadrao.Cells(Rows.Count, "A").End(xlUp).Row) - 1
' Fecho o arquivo já lido
ActiveWorkbook.Close SaveChanges:=False
' Tentando selecionar celula e arrastar conteudo ate a proxima vazia
Range("A" & r).Select
Range("A" & r).Copy
Range("A" & r & ":" & "A" & r2 + 1).PasteSpecial
Application.CutCopyMode = False
'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
Range("A" & r2 + 1).Select
End Sub
You want to paste the result value of the formula output or the gross formula itself?
– Evilmaax
Hello... I want to paste the result of the formula
– Klowaski
Any suggestions?
– Klowaski
What is the error? And what is the value of
r
and ofrTemp
– danieltakeshi