Usuários do Excel
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Listar o nome de várias guias em Diretório específico.

Ir para baixo

Listar o nome de várias guias em Diretório específico. Empty Listar o nome de várias guias em Diretório específico.

Mensagem por alexandrevba Qua maio 14, 2014 12:35 pm

Boa tarde!!

Como listar dentro de uma guia o nomes das guias de arquivos dentro de um determinado diretório.
Código:
Option Explicit

Sub ListWsheetClosedWrkbks()
'Listar o nome de várias guias em determinado diretório.
'Autor:JBeaucaire
Dim fPATH As String, fNAME As String
Dim wb As Workbook, wsList As Worksheet, wsNew As Worksheet
Dim sh As Long, Rw As Long, Col As Long

fPATH = "C:\test\"                          'path to files, remember the final \ in this string
fNAME = Dir(fPATH & "*.xl*")                'get the first filename from fPATH, edit filter as needed

Set wsList = ThisWorkbook.Sheets(1)        'the sheet in the workbook with the macro where the list is being created
wsList.UsedRange.ClearContents              'clear the prior list
Rw = 1                                      'first row to add info
Application.ScreenUpdating = False          'speed up macro
Application.DisplayAlerts = False          'no popup questions, default answers are selected

Do While Len(fNAME) > 0                    'loop one file at a time
    wsList.Cells(Rw, 1) = fNAME            'note the filename
    Col = 2                                'first column to note sheet names
    Set wb = Workbooks.Open(fPATH & fNAME)  'open the file
    For sh = 1 To wb.Sheets.Count          'loop through sheets and write names in successive columns
        wsList.Cells(Rw, Col).Value = wb.Sheets(sh).Name
        Col = Col + 1
    Next sh
    wb.Close False                          'close file, do not save
    Rw = Rw + 1                            'increment to next row
   
    fNAME = Dir()                          'get next filename using same filter as before
Loop

wsList.Columns.AutoFit                      'cleanup appearance
Application.ScreenUpdating = True          'back to normal, update screen
End Sub
alexandrevba
alexandrevba
Intermediário
Intermediário

Mensagens : 222
Data de inscrição : 26/06/2012
Localização : Serra-ES

Ir para o topo Ir para baixo

Ir para o topo

- Tópicos semelhantes

 
Permissões neste sub-fórum
Não podes responder a tópicos