Como percorrer os livros de uma pasta e copiar os respetivos dados para uma folha mestra no Excel?
Suponha que tem várias pastas de trabalho do Excel numa pasta e precisa de percorrer todos esses ficheiros para copiar dados de um intervalo específico numa folha consistente (por exemplo, Folha1) para uma planilha principal. Este guia oferece uma solução detalhada em VBA para agilizar este processo no Excel.
Percorrer livros numa pasta e copiar dados para uma folha mestra com código VBA
Percorrer ficheiros numa pasta e copiar dados para uma folha mestra com código VBA
Se pretender copiar os dados do intervalo A1:D4 de todas as folhas «Folha1» dos livros existentes numa pasta específica e colá-los numa folha mestra, siga os passos seguintes.
1. No livro onde irá criar uma Planilha Principal, prima as teclas Alt+F11 para abrir a janela do Microsoft Visual Basic para Aplicações.
2. Na janela do Microsoft Visual Basic para Aplicações, clique em Inserir > Módulo. Em seguida, copie o código VBA abaixo para a janela de código.
Código VBA: percorrer ficheiros numa pasta e copiar dados para uma folha mestra
Sub Merge2MultiSheets()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook As Workbook
Dim xSheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Sheet1"
xRgStr = "A1:D4"
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDlg
If .Show = -1 Then
xSelItem = .SelectedItems.Item(1)
Set xWorkBook = ThisWorkbook
Set xSheet = xWorkBook.Sheets("New Sheet")
If xSheet Is Nothing Then
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
Set xSheet = xWorkBook.Sheets("New Sheet")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
If xFileName = "" Then Exit Sub
Do Until xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xFileName = Dir()
xBook.Close
Loop
End If
End With
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End SubNota:
3. Prima a tecla F5 para executar o código.
4. Na janela Procurar que se abre, selecione a pasta que contém os ficheiros a percorrer e, em seguida, clique no botão OK. Veja a imagem:
É então criada uma Planilha Principal com o nome «Nova Folha» no final do Livro de Trabalho Atual. Os dados do intervalo A1:D4 de todas as Folhas1 da pasta selecionada são listados na folha de cálculo.
Artigos relacionados:
As Melhores Ferramentas de Produtividade para o Office
Potencie as suas competências no Excel com Kutools para Excel e experimente uma eficiência como nunca antes.Kutools para Excel Oferece mais de 300 funcionalidades avançadas para impulsionar a produtividade e Economizar Tempo.Clique aqui para obter a funcionalidade de que mais precisa...
Office Tab Traz uma interface com separadores para o Office e torna o seu trabalho muito mais fácil
- Ative a edição e leitura com separadores no Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
- Abra e crie vários documentos em novos separadores da mesma janela, em vez de em janelas separadas.
- Aumente a sua produtividade em 50 % e elimine centenas de cliques do rato todos os dias!
Todos os suplementos Kutools — num único instalador.
Kutools for Office reúne suplementos para Excel, Word, Outlook e PowerPoint, além do Office Tab Pro, sendo a solução ideal para equipas que trabalham em várias aplicações do Office.
- Pacote tudo-em-um— suplementos para Excel, Word, Outlook e PowerPoint + Office Tab Pro
- Um instalador, uma licença— configuração em minutos (pronto para MSI)
- Funciona melhor em conjunto— produtividade simplificada em todas as aplicações do Office
- Teste gratuito de 30 dias com todas as funcionalidades— sem registo, sem cartão de crédito
- Melhor relação qualidade-preço— poupe face à compra individual dos suplementos