Cookies op Tweakers

Tweakers is onderdeel van DPG Media en maakt gebruik van cookies, JavaScript en vergelijkbare technologie om je onder andere een optimale gebruikerservaring te bieden. Ook kan Tweakers hierdoor het gedrag van bezoekers vastleggen en analyseren. Door gebruik te maken van deze website, of door op 'Cookies accepteren' te klikken, geef je toestemming voor het gebruik van cookies. Wil je meer informatie over cookies en hoe ze worden gebruikt? Bekijk dan ons cookiebeleid.

Meer informatie
Toon posts:

excel bestanden samenvoegen

Pagina: 1
Acties:

Acties:
  • +1Henk 'm!

  • Paul1987
  • Registratie: oktober 2004
  • Laatst online: 01-08 10:26
Even heel snel iets in elkaar getikt voor je. Niet heel netjes maar het werkt (bij mij dan). Wel even de variabelen aanpassen naar wat jij nodig hebt.

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub import_collector()

Dim pad, ext, StrFile As String
Dim TargetWB, SourceWB As Workbook
Dim TargetSh, SourceSH As Worksheet

Dim SourceRng As Range
Dim r, last_r, Start_r As Long

Application.ScreenUpdating = False 'scherm verversen uitzetten

pad = "c:\test\"    'pad waar de bestanden staan
ext = "xlsx"        'extentie van de excel bestanden

Set TargetWB = ActiveWorkbook 'collector werkboek waar je de data naartoe haalt, ik ga er vanuit dat je het dus uitvoert vanuit het ontvangende bestand
Set TargetSh = TargetWB.Sheets("Blad1") 'doel blad


'alle bestanden die aan de criteria voldoen oplijsten en doorlopen
StrFile = Dir(pad & "\*" & ext)
Do While Len(StrFile) > 0 'doorgaan zolang er iets te halen valt
With TargetSh
last_r = .Cells(Rows.Count, 1).End(xlUp).Row
End With

Set SourceWB = Workbooks.Open(pad & StrFile)
Set SourceWS = SourceWB.Sheets(1) 'eerste sheet, kun je door ieder index nummer (of naam) vervangen
Set SourceRng = SourceWS.Range("a1:e27") 'test bereik. vervangen door wat jouw bereik is, niet zo mooi dat het een handmatige selectie is. Je zou dit dynamisch kunnen maken door automatisch de eerste en laatste rij/kolom op te zoeken
If last_r = 1 Then
Start_r = 1
Else
Start_r = last_r + 1
End If

SourceRng.Copy Destination:=TargetSh.Range("A" & Start_r) 'copy paste

SourceWB.Close savechanges:=False 'sluiten zonder opslaan
StrFile = Dir 'volgende bestand
Loop

Application.ScreenUpdating = True 'scherm verversen aanzetten


End Sub

Is dit het beste antwoord? Dan hoor ik dat graag!

Pagina: 1


Apple iPad Pro (2021) 11" Wi-Fi, 8GB ram Microsoft Xbox Series X LG CX Google Pixel 5a 5G Sony XH90 / XH92 Samsung Galaxy S21 5G Sony PlayStation 5 Nintendo Switch Lite

Tweakers vormt samen met Hardware Info, AutoTrack, Gaspedaal.nl, Nationale Vacaturebank, Intermediair en Independer DPG Online Services B.V.
Alle rechten voorbehouden © 1998 - 2021 Hosting door True