macro onbekend aantal cellen ophalen

[Renee123]

Hallo,

In een directory heb ik een excelbestand "samengevoegd.xlsm" wat het doelbestand is.
In dezelfde directory heb ik een mapje "losse bestanden" waarin een onbekend aantal excel bestanden staan.
Elk van die excelbestanden bevat tekst in de cellen A6 t/m E6. Ook in de rijen daaronder zijn kolom A t/m E gevuld, alleen het aantal rijen is onbekend en verschilt per excel bestand.

Wat ik zou willen is om met een macro de tekst uit al die bestanden te kopieren en dan onder elkaar in het doelbestand te zetten, te beginnen in cel A2.

Kan iemand mij op weg helpen?

 

[JEC.]

Hiermee zou je een eind moeten komen.
Run deze macro vanuit je doelbestand.

Pas het pad aan naar de juiste folder, waarin al die losse files staan.
Deze macro pakt iedere file uit die folder(geen subfolders) op, indien het een xls file is.

Sub jec()
  Dim xx As String, fl As Object, ar As Variant
  xx = "C:\xx\xx\Documents\xx\xx\"                'je folderpad waar
  Application.ScreenUpdating = False
  
  For Each fl In CreateObject("Scripting.filesystemobject").getfolder(xx).Files
    If Right(fl, 4) Like "xls*" Then
      With GetObject(fl).Sheets(1)
         ar = .Range("A6:E" & .Range("A" & Rows.Count).End(xlUp).Row)
         ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(ar), UBound(ar, 2)) = ar
         .Parent.Close 0
      End With
    End If
  Next
End Sub

 

[Renee123]

yes, dit werkt! En hier kan ik mee verder om de rest van de macro er om heen te maken.

Groet