kopiëren verwijzing naar telkens ander excel bestand

[markvdb]

ik wil dit kopiëren: =[1.xlsx]Blad1!$D$1
maar 1.xls moet 2.xls worden enz...

geen flauw idee hoe dat moet :-(

grz

 

[markvdb]

is dit te moeilijk of te gemakkelijk?

 

[arrie23]

Ik weet niet precies wat je bedoelt met kopieren maar als je onderstaande formule in cel A1 zet en doortrekt naar beneden krijg je in cel A1 de waarde van cel D1 van bestand 1, in cel A2 de waarde van cel D1 in bestand 2 etc:
=INDIRECT("["&RIJ()&".xls]Blad1!$D$1")
Bestanden 1 en 2 moeten dan wel geopend zijn.
Anders even een voorbeeldbestand plaatsen, dat helpt vaak

 

[markvdb]

:thumb: Dat is wat ik bedoel: een formule doortrekken naar beneden met als resultaat in cel A1 de waarde van cel D1 van bestand 1, in cel A2 de waarde van cel D1 in bestand 2 etc
de files worden effectief gesaved als 1.xls / 2.xls / 3.xls / ...
alleen is het niet praktisch dat alle files geopend moeten zijn omdat dit er honderden zijn en steeds meer worden
deze bestanden staan in dezelfde map als de overzichtsfile die ik probeer te maken: R:\fichen\

 

[arrie23]

De oplossing met de INDIRECT-functie werkt helaas alleen met geopende bestanden. Als je de informatie uit gesloten bestanden wil halen is denk ik een oplossing met VBA noodzakelijk. Dit is niet mijn sterkste punt. Wellicht dat er anderen zijn die je hiermee van dienst kunnen zijn.

 

[markvdb]

ok tnx!!!

 

[arrie23]

Ik heb deze link voor je gevonden: http://superuser.com/questions/441446/automatically-reading-data-from-separate-excel-files

Ik heb de code iets voor je aangepast en hier en daar wat commentaar ingevoegd. Uitgangspunt is dat je een masterbestand (je overzichtsfile) hebt in een bepaalde folder. De detailbestanden (1.xls, 2.xls etc.) staan in dezelfde folder in een submapje Details. Uiteraard is de naamgeving naar wens aan te passen.
Het runnen van de macro levert dan iets in de zin van:
1.xls G
2.xls H
3.xls I
4.xls J
5.xls K
etc.

Option Explicit
Sub ReadFilesInSequence()

  Dim FileName As String
  Dim FileNumber As Long
  Dim PathCrnt As String
  Dim RowDestCrnt As Long
  Dim SheetDest As String
  Dim TgtValue As String
  Dim WBookSrc As Workbook

  PathCrnt = ActiveWorkbook.Path & "\Details"
  'Uitgangspunt het masterbestand staat in dezelfde folder, de detailbestanden (1.xls, 2.xls etc) staan in de subfolder 'Details'

  SheetDest = "Blad1" 
  'Naam tabblad eventueel aanpassen
  RowDestCrnt = 1

  With Worksheets(SheetDest)
    ' Delete current contents of destination sheet
    .Cells.EntireRow.Delete
  End With

  FileNumber = 1

  Do While True

    FileName = Dir$(PathCrnt & "\" & FileNumber & ".xls*")
    If FileName = "" Then
      ' File does not exist
      Exit Do
    End If

    Set WBookSrc = Workbooks.Open(PathCrnt & "\" & FileName)
    With WBookSrc.Worksheets("Blad1") 'Naam tabblad eventueel aanpassen
      TgtValue = .Cells(1, "D").Value
    End With
    WBookSrc.Close SaveChanges:=False
    With Worksheets(SheetDest)
      .Cells(RowDestCrnt, "A").Value = FileName
      .Cells(RowDestCrnt, "B").Value = TgtValue
    End With
    RowDestCrnt = RowDestCrnt + 1

    FileNumber = FileNumber + 1

  Loop

End Sub

 

[markvdb]

super!!!
Dit werkt:
1.xlsx 1
2.xlsx 2
3.xlsx 3
4.xlsx 4
5.xlsx 5
6.xlsx 6
7.xlsx 7
8.xlsx 8
9.xlsx 9
10.xlsx 10


hoe kan ik nog meer data overhalen om in de kolommen ernaast te zetten?
Dit gewoon onder de vorige code plaatsen voor elke op te vullen kolom?:
(targetValue en RowDestCrnt aangepast)

Option Explicit
Sub ReadFilesInSequence()

Dim FileName As String
Dim FileNumber As Long
Dim PathCrnt As String
Dim RowDestCrnt As Long
Dim SheetDest As String
Dim TgtValue As String
Dim WBookSrc As Workbook

PathCrnt = ActiveWorkbook.Path & "\aanvragen"
'Uitgangspunt het masterbestand staat in dezelfde folder, de detailbestanden (1.xls, 2.xls etc) staan in de subfolder 'aanvragen'

SheetDest = "Blad1"
'Naam tabblad eventueel aanpassen
RowDestCrnt = 1

With Worksheets(SheetDest)
' Delete current contents of destination sheet
.Cells.EntireRow.Delete
End With

FileNumber = 1

Do While True

FileName = Dir$(PathCrnt & "" & FileNumber & ".xls*")
If FileName = "" Then
' File does not exist
Exit Do
End If

Set WBookSrc = Workbooks.Open(PathCrnt & "" & FileName)
With WBookSrc.Worksheets("Blad1") 'Naam tabblad eventueel aanpassen
TgtValue = .Cells(4, "G").Value
End With
WBookSrc.Close SaveChanges:=False
With Worksheets(SheetDest)
.Cells(RowDestCrnt, "A").Value = FileName
.Cells(RowDestCrnt, "C").Value = TgtValue
End With
RowDestCrnt = RowDestCrnt + 1

FileNumber = FileNumber + 1

Loop

End Sub

 

[arrie23]

Code zo aangepast dat de waarde van, als voorbeeld, cel K1 in kolom C wordt gezet. Hiervoor heb ik een TgtValue2 aangemaakt.

Option Explicit
Sub ReadFilesInSequence()

  Dim FileName As String
  Dim FileNumber As Long
  Dim PathCrnt As String
  Dim RowDestCrnt As Long
  Dim SheetDest As String
  Dim TgtValue As String
  Dim TgtValue2 As String
  Dim WBookSrc As Workbook

  PathCrnt = ActiveWorkbook.Path & "\Details"
  'Het masterbestand staat in dezelfde folder, de detailbestanden (1.xls, 2.xls etc) staan in de subfolder 'Details'

  SheetDest = "Blad1" 'Naam tabblad eventueel aanpassen
  RowDestCrnt = 1

  With Worksheets(SheetDest)
    ' Delete current contents of destination sheet
    .Cells.EntireRow.Delete
  End With

  FileNumber = 1

  Do While True

    FileName = Dir$(PathCrnt & "\" & FileNumber & ".xls*")
    If FileName = "" Then
      ' File does not exist
      Exit Do
    End If

    Set WBookSrc = Workbooks.Open(PathCrnt & "\" & FileName)
    With WBookSrc.Worksheets("Blad1") 'Naam tabblad eventueel aanpassen
      TgtValue = .Cells(1, "D").Value
      TgtValue2 = .Cells(1, "K").Value
    End With
    WBookSrc.Close SaveChanges:=False
    With Worksheets(SheetDest)
      .Cells(RowDestCrnt, "A").Value = FileName
      .Cells(RowDestCrnt, "B").Value = TgtValue
      .Cells(RowDestCrnt, "C").Value = TgtValue2
    End With
    RowDestCrnt = RowDestCrnt + 1

    FileNumber = FileNumber + 1

  Loop

End Sub

 

[markvdb]

Ik heb alle gegevens nu kunnen ophalen
Ik heb nu de gegevens ook kunnen plaatsen vanaf rij 2 maar rij 1, waar ik de kolomkoppen wil zetten wordt nog gedelete
Wss door dit:

With Worksheets(SheetDest)
' Delete current contents of destination sheet
.Cells.EntireRow.Delete

Hoe kan ik dit veranderen zodat rij 1 intact blijft?

tnx
mark

 

[arrie23]

Verander RowDestCrnt = 1 in RowDestCrnt = 2
en .Cells.EntireRow.Delete in Rows("2:" & Rows.Count).ClearContents

Option Explicit
Sub ReadFilesInSequence()

  Dim FileName As String
  Dim FileNumber As Long
  Dim PathCrnt As String
  Dim RowDestCrnt As Long
  Dim SheetDest As String
  Dim TgtValue As String
  Dim TgtValue2 As String
  Dim WBookSrc As Workbook

  PathCrnt = ActiveWorkbook.Path & "\Details"
  'Het masterbestand staat in dezelfde folder, de detailbestanden (1.xls, 2.xls etc) staan in de subfolder 'Details'

  SheetDest = "Blad1" 'Naam tabblad eventueel aanpassen
  RowDestCrnt = 2

  With Worksheets(SheetDest)
    ' Delete current contents of destination sheet
    Rows("2:" & Rows.Count).ClearContents
  End With

  FileNumber = 1

  Do While True

    FileName = Dir$(PathCrnt & "\" & FileNumber & ".xls*")
    If FileName = "" Then
      ' File does not exist
      Exit Do
    End If

    Set WBookSrc = Workbooks.Open(PathCrnt & "\" & FileName)
    With WBookSrc.Worksheets("Blad1") 'Naam tabblad eventueel aanpassen
      TgtValue = .Cells(1, "D").Value
      TgtValue2 = .Cells(1, "K").Value
    End With
    WBookSrc.Close SaveChanges:=False
    With Worksheets(SheetDest)
      .Cells(RowDestCrnt, "A").Value = FileName
      .Cells(RowDestCrnt, "B").Value = TgtValue
      .Cells(RowDestCrnt, "C").Value = TgtValue2
    End With
    RowDestCrnt = RowDestCrnt + 1

    FileNumber = FileNumber + 1

  Loop

End Sub

 

[markvdb]

tnx

werkt perfect nu

!!!!!!!!!!!!!!!!!!!!mijn dank is groot !!!!!!!!!!!!!!!!!!

:thumb::thumb::thumb::thumb::thumb::thumb::thumb::thumb::thumb::thumb::thumb::thumb: