Gegevens uit meerdere files naar 1 file

[Georgyboy]

Goedemorgen,

Is het mogelijk om uit verschillende Excelfiles (met dezelfde opmaak) gegevens te halen en deze naar een andere file te sturen?
Het gaat meestal om +/- 100 kleine Excelfiles die we kunnen importeren om daar een overzicht te hebben van enkele velden in 1 moederfile (gegevens).
Hier een voorbeeld van 3 files voor gegevens naar file “gegevens”.
In de files:
Start B4 (van de 3 files) naar gegevens Kolom A startdatum
Start C4 (van de 3 files) naar gegevens Kolom B starttijd
Start B5 (van de 3 files) naar gegevens Kolom C eindDatum
Start C5 (van de 3 files) naar gegevens Kolom D EindTijd
Start B6 (van de 3 files) naar gegevens Kolom E Batch

Alvast Bedankt,
Georgyboy

 

[AlexCEL]

2 Woorden: Power Query.

Uitleg o.a. hier: https://www.youtube.com/watch?v=fHFUh6EhBcw&ab_channel=LeilaGharani

 

[snb]

Zijn dit oorspronkelijk geen CSV-bestanden ?

 

[Georgyboy]

Dank voor de tip AlexCEL, ga dit bekijken en proberen te begrijpen.

@ snb
het zijn allemaal xlsx bestanden

Groeten,
georgyboy

 

[snb]

Dan zo: (pad in c00 aanpassen)

Sub M_snb()
  c00="G:\OF\"
  c01=dir(c00 & "*.xlsx")
  redim sn(300,4)

  do until c01=""
    if left(c01,4)="Prog" Then
      with getobject(c00 & c01)
        st=.sheets(1).range("B4:C6")
        .close 0
      end with 
      sn(n,0)=st(1,1)
      sn(n,1)=st(1,2)
      sn(n,2)=st(2,1)
      sn(n,3)=st(2,2)
      sn(n,4)=st(3,1)
      n = n + 1
   end if
   c01=dir
  loop

  thisworkbook.sheets(1).cells(1).resize(n,5)=sn
End Sub

 

[Georgyboy]

Dankjewel snb

hier loop ik denk ik vast ""#FFFF00"]ThisWorkbook.Sheets(1).Cells(1).Resize(n, 5) = sn"

waarschijnlijk doe ik iets fout?

Sorry !

Sub M_snb()
  c00 = "\\me-fp00\userdesk$\geo\Desktop\Geo\Computer tips\Excel VBA testen\Gegevens van meerdere bestanden naar 1"
  c01 = Dir(c00 & "*.xlsx")
  ReDim sn(300, 4)

  Do Until c01 = ""
    If Left(c01, 4) = "Prog" Then
      With GetObject(c00 & c01)
        st = .Sheets(1).Range("B4:C6")
        .Close 0
      End With
      sn(n, 0) = st(1, 1)
      sn(n, 1) = st(1, 2)
      sn(n, 2) = st(2, 1)
      sn(n, 3) = st(2, 2)
      sn(n, 4) = st(3, 1)
      n = n + 1
   End If
   c01 = Dir
  Loop

  [COLOR="#FFFF00"]ThisWorkbook.Sheets(1).Cells(1).Resize(n, 5) = sn[/COLOR]
End Sub

 

[snb]

Het pad in c00 moet natuurlijk wel altijd eindigen op een backslash \

 

[Georgyboy]

Dankjewel snb

Het werkt ! en weer veel mogen bijleren

Getest met

If Left(c01, 4) = "GEKO" Then

kunnen hier meerdere afkortingen?

PS
1) kan de regel ook op de 2° lijn beginnen?
2) Kan de bestandsnaam er ook bij?

@ AlexCEL probeer ook te leren met Power Query

Groeten,
Georgyboy

 

[snb]

1) kan de regel ook op de 2° lijn beginnen?

ThisWorkbook.Sheets(1).Cells(2,1).Resize(n, 5) = sn

2) Kan de bestandsnaam er ook bij?

Waar ?

Meer afkortingen:
bijv. "GEKO" en "Prog"

If instr("GEKOProg",Left(c01, 4)) Then

 

[Georgyboy]

Dankjewel heel leerrijk voor me en waarschijnlijk zo simpel voor je?
Heb nog véél te leren en wil je, jullie bedanken voor de inspanningen en tijd.

"bestandsnaam " indien mogelijk in kolom A

Groeten,
Georgyboy

 

[snb]

Dan wordt het:

Sub M_snb()
  c00="G:\OF\"
  c01=dir(c00 & "*.xlsx")
  redim sn(300,5)

  do until c01=""
    if left(c01,4)="Prog" Then
      with getobject(c00 & c01)
        st=.sheets(1).range("B4:C6")
        .close 0
      end with
      sn(n,0)=c01 
      sn(n,1)=st(1,1)
      sn(n,2)=st(1,2)
      sn(n,3)=st(2,1)
      sn(n,4)=st(2,2)
      sn(n,5)=st(3,1)
      n = n + 1
   end if
   c01 = dir
  loop

  thisworkbook.sheets(1).cells(2,1).resize(n,6)=sn
End Sub

 

[Georgyboy]

Werkt helemaal Top! weer veel mogen bijleren

Hartelijk dank!