Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

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
Antworten 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)
Antworten Top


Gehe zu:


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