Kombinere arbeidsbøker i Excel til en fil

[BA1]

Hei.

 

På jobben får jeg daglige excel rapporter med arbeidsoperasjoner som er blitt utført og timetall.

 

Jeg ønsker å kombinere disse rapportene (enkelt filer) i et regneark for å kunne bruke Pivot tabeller o.l.

 

Noen som har tips til hva som er beste fremgangsmåte for dette? Makro, eget program etc? Kanskje noen kan hjelpe med kodesnutter dersom dette kan løses med en makro?

Har programmert litt i C++ før, men er ganske blank på VB.

 

På forhånd takk

[aadnk]

Noe som følger burde fungere (kjør Main()-prosedyren):

Klikk for å se/fjerne innholdet nedenfor

Public Sub Main()

 

    ' Sheet1 er arket du må legge denne markoen inn i.

    RemoveAllSheets Sheets, Sheet1.Name

    AddAllSheetsFromDirectory Sheets, "D:\Temp", False ' Husk å endre sti

   

End Sub

 

Public Sub RemoveAllSheets(Source As Sheets, Optional Ignore As String)

 

    Dim Tell As Integer

 

    ' Slett hvert ark en etter en

    For Tell = Source.Count To 1 Step -1

        If Source(Tell).Name <> Ignore Then

            Source(Tell).Delete

        End If

    Next

 

End Sub

 

Public Sub AddAllSheetsFromDirectory(Destination As Sheets, Path As String, SearchInSubFolders As Boolean)

   

    Dim File, Workbook As Workbook, Sheet As Object

   

    ' Gå gjennom hver fil i mappen

    For Each File In RetriveFileList(Path, "*.xlsx", SearchInSubFolders)

   

        ' Åpne denne filen

        Set Workbook = Workbooks.Open(File)

   

        ' Last inn alle ark

        For Each Sheet In Workbook.Sheets

            Sheet.Copy After:=Destination(Destination.Count)

        Next

       

        ' Lukk filen

        Workbook.Close False

   

    Next

 

End Sub

 

Public Function ValidPath(sFile As String) As String

 

    ' Add a slash if needed

    ValidPath = sFile & IIf(Right(sFile, 1) = "\", "", "\")

 

End Function

 

Public Function RetriveFileList(sPath As String, sFileExtension As String, bSubFolders As Boolean, Optional Attributes As VbFileAttribute = vbDirectory) As Collection

 

    Dim Folders As New Collection, Folder, File As String, vFile

    Dim sFileName As String, bAdd As Boolean

   

    ' Create a new file container

    Set RetriveFileList = New Collection

   

    ' Find all files and folders

    File = Dir(ValidPath(sPath), Attributes)

 

    ' Loop until we've found the last file/folder

    Do While File <> ""

   

        ' Firstly, see if this in fact IS a file or folder

        If File <> "." And File <> ".." Then

   

            ' Then find out whether or not this is a file

            If File Like "*.*" Then

                ' Further on, it needs to meat a certain pattern

                If File Like sFileExtension Then

                    RetriveFileList.Add ValidPath(sPath) & File

                End If

            Else ' If not, this must be a folder

                Folders.Add ValidPath(sPath) & File

            End If

   

        End If

       

        ' Find the next file/folder

        File = Dir

   

    Loop

   

    ' Look in subfolders if requested

    If bSubFolders Then

       

        ' Go through all folders found

        For Each Folder In Folders

            ' Search inside this folder as well

            For Each vFile In RetriveFileList(CStr(Folder), sFileExtension, True, Attributes)

                RetriveFileList.Add vFile

            Next

        Next

   

    End If

 

End Function