De seus comentários, presumo que você nunca tenha escrito uma macro VBA. Sua primeira macro será uma subida difícil, mas depois disso, cada uma será mais fácil até você esquecer que alguma vez pensou que seria difícil escrever.
A macro abaixo pressupõe que todas as 2.500 pastas de trabalho estão na mesma pasta. Esta é geralmente a abordagem mais fácil, mas pode não ser possível no seu caso. Se não for possível, escolha uma pasta com várias pastas de trabalho para experimentar essa macro. Terá de adicionar uma explicação da sua situação à sua pergunta para que eu possa explicar como esta macro pode ser adaptada para a resolver.
Eu tentei manter as coisas simples, embora possa não parecer assim. Existem maneiras melhores e mais rápidas de fazer a mesma coisa, mas acho que esse é o compromisso certo. Eu incluí muitos comentários explicando o que o código faz. A ajuda do editor de macro irá explicar a sintaxe. Mas pergunte se você está com dificuldades.
Crie uma nova pasta de trabalho na pasta escolhida para o teste. Meu código espera uma planilha chamada "Bobert", que é conveniente para mim. Escolha um nome que faça sentido para você e altere o código para corresponder; Eu te digo mais tarde.
Selecione Tools
, em seguida, Macro
, em seguida, Visual Basic Editor
ou clique em Alt
+ F11
.
Na esquerda, você terá o explorador do projeto. No topo à direita, você terá uma área cinza. Na parte inferior à direita, você terá a janela imediata. Eu posso falar sobre a janela imediata depois.
Selecione Insert
, em seguida, Module
. "Module1" será adicionado ao explorador do projeto e a área cinza ficará branca. Esta é a área de código do Módulo1.
Você pode deixar o nome do módulo como "Module1" ou pode alterá-lo. Clique em F4. A janela Propriedades será exibida. A única propriedade de um módulo é seu nome. Clique em "Módulo 1" em "(Name) Module1", retroceda "Module1" e digite um nome à sua escolha. Feche a janela Propriedades.
Copie o código abaixo para a área de código.
Esta macro aborda a primeira parte do seu problema: ela encontra todas as pastas de trabalho na pasta e todas as planilhas dentro dessas pastas de trabalho. Ele cria uma lista dessas planilhas na planilha "Bobert". Se as 2.500 pastas de trabalho não puderem ser reunidas em uma única pasta, talvez você precise de uma macro como essa para criar uma lista das pastas de trabalho e planilhas a serem examinadas, mas essa macro destina-se a ser um exercício de treinamento. Crie uma linha de cabeçalho:
A1 = Folder
B1 = Workbook
C1 = Worksheet
A única declaração que você precisará alterar imediatamente é:
Set WShtDest = ActiveWorkbook.Worksheets("Bobert")
Altere "Bobert" para o nome que você escolheu para a planilha na qual a lista de planilhas será criada.
Coloque o cursor na declaração:
RowDestCrnt = .Cells(Rows.Count, "A").End(xlUp).Row + 1
e clique em F9. A linha ficará marrom porque você fez disso um ponto de interrupção que eu explico em um momento.
Sempre que você clicar em F8, uma declaração do código será obedecida. Isso permite percorrer o código. Se você colocar o cursor sobre um nome de variável, seu valor será exibido. Você pode mudar para a planilha para verificar o que mudou.
Se você acha que entende um bloco de código, clique em F5 e o código será executado até o próximo ponto de interrupção. Eu defini um, mas você pode definir quantas quiser.
Espero que isso lhe dê algo em que pensar. Responda às minhas perguntas e posso dar a próxima parte da solução.
Option Explicit
' Searching for content in a large number of Excel files
' http://superuser.com/q/452980/108084
Sub ListWorksheets()
Dim ColDestCrnt As Long
Dim FileNameList() As String
Dim InxFNL As Long
Dim InxW As Long
Dim PathCrnt As String
Dim RowDestCrnt As Long
Dim WBkSource As Workbook
Dim WShtDest As Worksheet
Application.ScreenUpdating = False
' Create a reference to the worksheet in which data will be stored
' Change "Bobert" to your name for the destination worksheet.
Set WShtDest = ActiveWorkbook.Worksheets("Bobert")
' This assumes the source workbooks are in the same folder as the workbook
' holding this macro. You could replace this with a statement like:
' PathCrnt = "C:\MyFiles"
PathCrnt = ActiveWorkbook.Path
' GetFileNameList is a subroutine I wrote sometime ago. It returns an
' array of filenames within a specified folder (PathCrnt) that match a
' specified format (*.xls).
Call GetFileNameList(PathCrnt, "*.xls", FileNameList)
' Get the next free row in worksheet Bobert. By calling this routine with
' different values for PathCrnt, you could built up a list containing files
' from many folders.
With WShtDest
RowDestCrnt = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End With
For InxFNL = LBound(FileNameList) To UBound(FileNameList)
If FileNameList(InxFNL) <> ActiveWorkbook.Name Then
' In the Workbook Open statement, 0 means "do not update any links" and
' True means "open read only"
Set WBkSource = Workbooks.Open(PathCrnt & "\" & FileNameList(InxFNL), 0, True)
With WBkSource
' Record the name of each worksheet in the workbook
For InxW = 1 To .Worksheets.Count
WShtDest.Cells(RowDestCrnt, "A").Value = PathCrnt
WShtDest.Cells(RowDestCrnt, "B").Value = FileNameList(InxFNL)
WShtDest.Cells(RowDestCrnt, "C").Value = .Worksheets(InxW).Name
RowDestCrnt = RowDestCrnt + 1
Next
.Close SaveChanges:=False ' Close this source workbook
End With
End If
Next
End Sub
Sub GetFileNameList(ByVal PathCrnt As String, ByVal FileSpec As String, _
ByRef FileNameList() As String)
' This routine sets FileNameList to the names of files within folder
' PathCrnt that match FileSpec. It uses function Dir$() to get the file names.
' I can find no documentation that says Dir$() gets file names in alphabetic
' order but I have not seen a different sequence in recent years.
Dim AttCrnt As Long
Dim FileNameCrnt As String
Dim InxFNLCrnt As Long
' I initialise the array with space for 100 files and then enlarge it if
' necessary. This is normally enough space for my applications but since
' you are expecting 2,500 files I have replaced the original statement.
'ReDim FileNameList(1 To 100)
ReDim FileNameList(1 To 2500)
InxFNLCrnt = 0
' Ensure path name ends in a "\"
If Right(PathCrnt, 1) <> "\" Then
PathCrnt = PathCrnt & "\"
End If
' This Dir$ returns the name of the first file in
' folder PathCrnt that matches FileSpec.
FileNameCrnt = Dir$(PathCrnt & FileSpec)
Do While FileNameCrnt <> ""
' "Files" have attributes, for example: normal, to-be-archived, system,
' hidden, directory and label. It is unlikely that any directory will
' have an extension of XLS but it is not forbidden. More importantly,
' if the files have more than one extension so you have to use "*.*"
' instead of *.xls", Dir$ will return the names of directories. Labels
' can only appear in route directories and I have not bothered to test
' for them
AttCrnt = GetAttr(PathCrnt & FileNameCrnt)
If (AttCrnt And vbDirectory) <> 0 Then
' This "file" is a directory. Ignore
Else
' This "file" is a file
InxFNLCrnt = InxFNLCrnt + 1
If InxFNLCrnt > UBound(FileNameList) Then
' There is a lot of system activity behind "Redim Preserve". I reduce
' the number of Redim Preserves by adding new entries in chunks and
' using InxFNLCrnt to identify the next free entry.
ReDim Preserve FileNameList(1 To 100 + UBound(FileNameList))
End If
FileNameList(InxFNLCrnt) = FileNameCrnt
End If
' This Dir$ returns the name of the next file that matches
' the criteria specified in the initial call.
FileNameCrnt = Dir$
Loop
' Discard the unused entries
ReDim Preserve FileNameList(1 To InxFNLCrnt)
End Sub