Ajuda: programação de macro VB em Excel

[nickie]

Olá a todos,

Queria pedir a vossa ajuda para um problema que tenho em mãos. Já andei a tentar resolver, mas não consigo arranjar solução.
O que se passa é o seguinte:
- tenho mais de duas centenas de ficheiros (xlsm) num diretório os quais são constituidos por 2 worksheets: uma com uma macro (escrita por uma empresa) e outra com dados que essa macro extrai de uma base de dados. As folhas com dados estão com o nome sheet1.
- devido à imensidão de ficheiros, queria criar uma macro em excel que fizesse o seguinte:
. ler ficheiros que estão no diretório
. abrir cada um dos ficheiros individualmente e sequencialmente
. em cada um dos ficheiros copiar toda a sheet1 para um novo workbook
. dar o nome do ficheiro original (que está com extensão xlsm) ao novo workbook e gravar como xlsx

Alguém sabe como se pode programar isso em excel?

Obrigado pela ajuda!

 

[fmf1966]

Tenta isto:

Public Sub GravarSheet1()
    Dim S As String, F As String, X As String
    Dim Xl As Excel.Application
    Dim Wx As Workbook, Sh As Worksheet
    
    F = GetFolder()
    
    If F = "" Then Exit Sub
    F = F & "\"
    Set Xl = CreateObject("Excel.Application")
    Xl.DisplayAlerts = False
    Xl.EnableEvents = False
    
    S = Dir(F & "*.xlsm")
    Do Until S = ""
        Set Wx = Xl.Workbooks.Open(F & S)
        X = F & Left(S, Len(S) - 5)
        For Each Sh In Wx.Sheets
            If Sh.Name <> "sheet1 " Then
                Sh.Delete
            End If
        Next
        Wx.SaveAs X, xlWorkbookDefault
        Wx.Close
        S = Dir()
    Loop
    
    Xl.EnableEvents = True
    Xl.DisplayAlerts = True
    Xl.Quit
    MsgBox "Terminado"
End Sub

Public Function GetFolder() As String
    Dim objFSO As Object
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "", 0)
    If objFolder Is Nothing Then
        GetFolder = ""
    Else
        Set objFolderItem = objFolder.Self
        GetFolder = objFolderItem.Path
    End If
End Function

Por não saber se tu tens conhecimentos de VBA Excel, não coloquei a explicação.
Se tiveres duvidas, pergunta.