Jump to content
Sign in to follow this  
Kubrick

Importar Ficheiros Excel Para...excel

Recommended Posts

Parece simples mas o 2007 não me dá esta hipótese. Tenho uma pasta com 101 ficheiros excel que têm todos a mesma tabela, mas com valores diferentes. Quero improtar o conteudo de cada um deles para uma unica "worksheet", para montar uma tabela gigante com os dados presentes nesses 101 ficheiros. No fundo quero importar fihceiros excel para o excel, sem ter de estar a abrir a fazer copy e paste.

Alguém consegue?

:fnf:

Share this post


Link to post
Share on other sites

A única maneira que conheço é clicar com o botão direito do rato na folha e fazer copiar para "ficheiro de excel já aberto". Isto é, tens que ter os dois abertos e mandar copiar a folha para o que ficheiro que tu queres.

Share this post


Link to post
Share on other sites

Eu há uns tempos tinha procurado uma macro para fazer algo parecido e cheguei a esta solução com duas macros, pode ser que te sirva, se bem me lembro que foi há uns meses funcionou:

1º esta combina os ficheiros todos num ficheiro só


Sub combinar()

Dim FilesToOpen
Dim x As Integer

On Error GoTo ErrHandler
Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="Files to Merge")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Nenhum Ficheiro foi seleccionado"
GoTo ExitHandler
End If

x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open Filename:=FilesToOpen(x)
Sheets().Move After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)
x = x + 1
Wend

'Aqui é para apagar as sheets importada sem dados
Dim ws As Worksheet
Application.DisplayAlerts = False

For Each ws In Worksheets
If ws.UsedRange.Cells.Count < 2 Then ws.Delete
Next ws

Application.DisplayAlerts = True

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
[/code] Se os teus ficheiros estiverem gravados em formato .xlsx, em cima podes ter de substituir o .xls por .xlsx, porque isto foi feito em excel 2003 depois esta combinava todas as sheets numa só com o nome combinado
[code]Sub combinarsheets()
Dim z As Integer

On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combinado"

Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")

For z = 2 To Sheets.Count
Sheets(z).Activate
Range("A1").Select
Selection.CurrentRegion.Select

Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Edited by Perks

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
Sign in to follow this  

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...

Important Information

We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.