Como mesclar várias planilhas de arquivos do Excel em um arquivo do Excel?

Question

Eu preciso mesclar cem arquivos do Excel em um arquivo do Excel. Cada arquivo do Excel precisa ser mesclado em sua própria planilha na pasta de trabalho e a planilha de destino precisa ter o nome do arquivo original (menos a extensão). Isso é possível?

    

Answer 1

Bem, não parece que você tenha feito nenhum esforço nisso, mas como eu já tenho essas macros escritas, eu as forneço para qualquer outra pessoa que esteja pesquisando. Estes foram escritos em excel 2007 e fizeram parte de um processo maior.

É importante notar que isso falhará se algum dos seus nomes de arquivo tiver mais de 31 caracteres, o excel tem um limite de caracteres para os nomes das planilhas

Combine os arquivos em um com o nome das planilhas que estão sendo definidos para o nome do arquivo -

Sub CombineWSs()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    MyPath = "C:\Documents and Settings\path\to"
    Set wbDst = ThisWorkbook
    strFilename = Dir(MyPath & "\*.xls", vbNormal)

    If Len(strFilename) = 0 Then Exit Sub

    Do Until strFilename = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)

            Set wsSrc = wbSrc.Worksheets(1)

            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

            wbSrc.Close False

        strFilename = Dir()

    Loop
    wbDst.Worksheets(1).Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Agora percorra as planilhas para remover os cinco últimos caracteres do nome da planilha: .xlsx

Sub RenameWS()
Application.ScreenUpdating = False
Dim strName As String
Dim intLength As Integer

For Each Sheet In ActiveWorkbook.Worksheets
    strName = Sheet.Name
    intLength = Len(strName)
    strName = Left(strName, intLength - 5)
    Sheet.Name = strName

Next
Application.ScreenUpdating = True
End Sub