I'm trying to gather data from multiple files into a single worksheet. In some searches I did for the network, I found several suggestions, and below is 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 moment of pasting the data into the target.
I need "Special Glue" so that in the cells that contained formula results, either the value that was of the formula was pasted.
I have tried in many ways to use a ".PasteSpecial Paste: = xlPasteValues" of life, but always the error in the line code below:
'Colo na planilha principal
ActiveWorkbook.ActiveSheet.Range("A2:BA" & rTemp).Copy shPadrao.Range("B" & r)
Following complete 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