Excel VBA - importeren

excel_vba_dynamisch_importeren

De onderstaande procedure zoekt naar bron-werkmappen (xlsx) om deze te openen en te importeren naar de doel-werkmap.

De locatie waarin gezocht wordt is relatief ten opzichte van de locatie van de doel-werkmap.

De enige voorwaarde voor het goed functioneren van deze procedure is dat zowel de bron- als de doelwerkmap dezelfde indeling hebben qua kolommen. Voor de rest is deze functionaliteit geheel dynamisch en dus niet gebonden aan een vooraf vast gesteld aantal kolommen of rijen.

'-----------------------------------------------------------------------------------------------------------------------
' Auteur        : pascalterheege.nl
' Datum         : 6-1-2016
' Object        : modImporteer
' Doel          : xlsx-bestanden uit \bron\ importeren naar huidig werkboek
' Verwijzing    : Microsft Scripting Runtime
' Bron          :
'-----------------------------------------------------------------------------------------------------------------------
Option Explicit

Sub importeerBestanden()

'   Variabelen declareren
    Dim fso As New FileSystemObject     'FSO
    Dim fld As Folder
    Dim f As File
    
    Dim strLocatie As String            'Locatie
    
    Dim wbDoel As Workbook              'Doel
    Dim rngDoel As Range
    
    Dim wbBron As Workbook              'Bron
    Dim rngBron As Range
    
'   Variabelen initialiseren
    Set wbDoel = ActiveWorkbook                             'Doel
    strLocatie = wbDoel.Path & Application.PathSeparator _
    & "Bron" & Application.PathSeparator                    'Relatieve padverwijzing t.o.v. doel.xlsm
    
    Set fld = fso.GetFolder(strLocatie)
     
'   Schermactiviteit uitschakelen t.b.v performance
    Application.ScreenUpdating = False
    
'   Itereren door gevonden bestanden in locatie
    For Each f In fld.Files
    
'       Alleen xlsx bestanden!
        If fso.GetExtensionName(f) = "xlsx" Then
    
'           Dynamische bron range (exclusief header)
            Set wbBron = Workbooks.Open(f)                                  'bronbestand openen
            Set rngBron = wbBron.Sheets(1).Range("A1").CurrentRegion        'bronrange is huidig bereik (currentregion) t.o.v. A1
            Set rngBron = rngBron.Offset(1).Resize(rngBron.Rows.Count _
            - 1, rngBron.Columns.Count)                                     'bronrange exlusief header!
            
'           Dynamische doel range (laatste regel + 1)
            Set rngDoel = wbDoel.Sheets(1).Range("A" & wbDoel.Sheets(1) _
            .Range("A" & Rows.Count).End(xlUp).Row + 1)
            
'           Bron kopieren naar doel
            rngBron.Copy Destination:=rngDoel
            
'           Bron sluiten
            wbBron.Close
        
        End If
        
    Next f
            
'   Schermactiviteit aanschakelen
    Application.ScreenUpdating = True
            
End Sub

Download hier het oefenbestand.