Makro um mehrere Dateinamen zu importieren
#1
Hallo, ich habe folgendes Problem.
Ich habe bereits ein Makro erstellt mit dem ich mehrere exceldateien zusammenführen kann. Diese stehen dann untereinander in einer exceldatei.
Nun soll aber in der ersten Spalte jeweils der Dateiname dder importierten Datei stehen. Und da komme ich einfach nicht weiter.
Mein bisheriger Code sieht so aus.
Wäre echt toll wenn mir jemand helfen könnte.


Code:
Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
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
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
Top
#2
Hallo Molie,

in Deinem Code hast Du nach dem Kopieren zum Einfügen diese Zeile:
Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + 1)
Um in der Spalte A Platz für die Dateinamen zu schaffen, müsstest Du das Ziel in die Spalte B legen.

Den Namen der Datei, die Du zum Kopieren öffnest, hast Du in dieser variablen: varDateien(lngAnzahl)

Wenn Du den Namen z.B. nur in der ersten Datenzeile der zugehörigen Daten haben willst, könntest Du das vor dem Kopieren und Einfügen der Daten programmieren, z.B. so:
WBZ.Worksheets(1).Range("B" & WBZ.Worksheets(1).Range("B65536").End(xlUp).Row + 1) = varDateien(lngAnzahl)

Ein kleiner Hinweis noch. Wenn Du mehr als 65536 füllst, ist diese Begrenzung natürlich unpassend. Du könntest bei Deiner Programmierweise z.B. stattdessen so vorgehen:
....Range("B" & Rows.Count)....
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste