Excel (VBA) - Copy data from files

Asked

Viewed 1,380 times

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?

  • Hello... I want to paste the result of the formula

  • Any suggestions?

  • What is the error? And what is the value of r and of rTemp

3 answers

0

Um... look at what I understand you want to paste only the result of the formula, but you used the function Application.CutCopyMode = False try to use it!

    'Celula que contem a formula
Range("A1").Select
'Usando a funcao Copy do VBA
Selection.Copy
'Seleciono o Destino do Paste
Range("B1").Select
'Usando a Funcao Paste Special,
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
'Informo o Metodo de copia
Application.CutCopyMode = False

If you’ve helped, I’ll be glad :)

  • For better service, select only the data which the cells are filled!

  • Hello Ezequiel, all right? Thank you for answering, but this part of the code is working. In it there are two times when information is pasted. The part that is problematic in the code is here: 'Colo in the main sheet Activeworkbook.ActiveSheet.Range("A2:BA" & rTemp). Copy shPadrao.Range("B" & r)

  • Avoid using .Select

-1

Try that one:

wsOrigem.Range("A1").Copy
wsDestino.Range ("B1").PasteSpecial xlValues

-2

Specific given copies between two worksheets

Aba Carteira Aba Plhan1

Wallet Tab > Specific product (cement)

Browser other questions tagged

You are not signed in. Login or sign up in order to post.