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.
01 | '----------------------------------------------------------------------------------------------------------------------- |
02 | ' Auteur : pascalterheege.nl |
03 | ' Datum : 6-1-2016 |
04 | ' Object : modImporteer |
05 | ' Doel : xlsx-bestanden uit \bron\ importeren naar huidig werkboek |
06 | ' Verwijzing : Microsft Scripting Runtime |
07 | ' Bron : |
08 | '----------------------------------------------------------------------------------------------------------------------- |
09 | Option Explicit |
10 |
11 | Sub importeerBestanden() |
12 |
13 | ' Variabelen declareren |
14 | Dim fso As New FileSystemObject 'FSO |
15 | Dim fld As Folder |
16 | Dim f As File |
17 | |
18 | Dim strLocatie As String 'Locatie |
19 | |
20 | Dim wbDoel As Workbook 'Doel |
21 | Dim rngDoel As Range |
22 | |
23 | Dim wbBron As Workbook 'Bron |
24 | Dim rngBron As Range |
25 | |
26 | ' Variabelen initialiseren |
27 | Set wbDoel = ActiveWorkbook 'Doel |
28 | strLocatie = wbDoel.Path & Application.PathSeparator _ |
29 | & "Bron" & Application.PathSeparator 'Relatieve padverwijzing t.o.v. doel.xlsm |
30 | |
31 | Set fld = fso.GetFolder(strLocatie) |
32 | |
33 | ' Schermactiviteit uitschakelen t.b.v performance |
34 | Application.ScreenUpdating = False |
35 | |
36 | ' Itereren door gevonden bestanden in locatie |
37 | For Each f In fld.Files |
38 | |
39 | ' Alleen xlsx bestanden! |
40 | If fso.GetExtensionName(f) = "xlsx" Then |
41 | |
42 | ' Dynamische bron range (exclusief header) |
43 | Set wbBron = Workbooks.Open(f) 'bronbestand openen |
44 | Set rngBron = wbBron.Sheets(1).Range("A1").CurrentRegion 'bronrange is huidig bereik (currentregion) t.o.v. A1 |
45 | Set rngBron = rngBron.Offset(1).Resize(rngBron.Rows.Count _ |
46 | - 1, rngBron.Columns.Count) 'bronrange exlusief header! |
47 | |
48 | ' Dynamische doel range (laatste regel + 1) |
49 | Set rngDoel = wbDoel.Sheets(1).Range("A" & wbDoel.Sheets(1) _ |
50 | .Range("A" & Rows.Count).End(xlUp).Row + 1) |
51 | |
52 | ' Bron kopieren naar doel |
53 | rngBron.Copy Destination:=rngDoel |
54 | |
55 | ' Bron sluiten |
56 | wbBron.Close |
57 | |
58 | End If |
59 | |
60 | Next f |
61 | |
62 | ' Schermactiviteit aanschakelen |
63 | Application.ScreenUpdating = True |
64 | |
65 | End Sub |
Download hier het oefenbestand.