Jump to content

Importar Ficheiros Excel Para...excel


Kubrick
 Share

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:

Link to comment
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.

Link to comment
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
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

  • 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.