Clever-Excel-Forum

Hallo zusammen,

kurze Schilderung des Problems.
Ich habe einen Ordner mit einer variablen Anzahl an Excel Dateien, fester Pfad.
Jetzt habe ich einen VBA Code der mir alle Informationen aus allen Excel Dateien in eine Tabelle(immer das selbe Sheet) konsolidiert, A1 ist immer die gleiche Überschrift.
Da es alles automatisch Ablaufen soll, habe ich das Problem das bei dem Code ein Popup kommt wo ich die Daten auswählen soll (händisch).
Inwiefern muss ich den Code verändern, damit ich mit einem Klick alle Daten habe, wie es der Code beschreibt aber nicht die händische Auswahl tätigen muss?

Code:
Sub zusammenfügen()

On Error GoTo errExit

Dim WBQ As Workbook

Dim wbz As Workbook

Dim varDateien As Variant

Dim lngAnzahl As Long

Dim lngLastQ As Long

Set wbz = ActiveWorkbook

'Altdaten auf Zielblatt löschen

wbz.Worksheets(1).Range("A2:IV65536").ClearContents

varDateien = Application.GetOpenFilename("Datei (*.xlsx),*.xlsx", False, "Bitte gewünschte Datei(en) markieren", False, True)

With Application

  .ScreenUpdating = False

  .EnableEvents = False

  .Calculation = xlCalculationManual

End With

For lngAnzahl = LBound(varDateien) To UBound(varDateien)

Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))

  lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row

  WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _

  Destination:=wbz.Worksheets(1).Range("A" & wbz.Worksheets(1).Range("A65536").End(xlUp).Row + 1)

WBQ.Close SaveChanges:=True 'Neu

Next

With Application

  .ScreenUpdating = True

  .EnableEvents = True

  .Calculation = xlCalculationAutomatic

End With

MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64

Exit Sub

errExit:

With Application

  .ScreenUpdating = True

  .EnableEvents = True

  .Calculation = xlCalculationAutomatic

End With

If Err.Number = 13 Then

MsgBox "Es wurde keine Datei ausgewählt"

  Else

MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _

& "Fehlernummer: " & Err.Number & vbCr _

& "Fehlerbeschreibung: " & Err.Description

End If

End Sub

Moin,
mal nachgefragt: Warum VBA wo du doch mit 2016 Möglichkeiten hast, das Ganze ohne eine Zeile VBA-Code zu lösen?

Das ganze soll später aus Access heraus funktionieren.
Access soll auf diese Zusammengefasste Excel Tabelle zugreifen.
In Access gibt es dann ein Button der dieses Makro auslöst und da die Daten sich kontinuierlich ändern muss das ein Makro sein.

Private Sub Cmdzusammenfügen_Click()
Dim xlApp As Object
Dim sFile As String

sFile = "Hier steht der Pfad"
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open sFile
xlApp.Run "zusammenfügen"
xlApp.Workbooks.Close

Set xlApp = Nothing
End Sub

Hallo, :19:

Zitat:In Access gibt es dann ein Button der dieses Makro auslöst und da die Daten sich kontinuierlich ändern muss das ein Makro sein.

Wenn es von Access aus laufen soll, würde ich trotzdem die Exceldatei mit PowerQuery aufbereiten und dann nach folgendem Muster vorgehen: :21:

Aus AEK 20 der letzte Download (PowerQuery)...

Du musst dich natürlich erst Mal mit PQ auseinandersetzen. Dodgy

Im Anhang noch eine Möglichkeit für Excel (Anpassungen nicht vergessen - siehe Kommentar im Code).

Hat funktioniert,

Vielen Vielen Dank :)

Kongur

GMG-CC

Kongur

Case

Kongur