Thema Datum  Von Nutzer Rating
Antwort
Rot Dateititel in Zelle schreiben anhand der Zelleneinträge
13.07.2013 10:57:26 JcD
NotSolved

Ansicht des Beitrags:
Von:
JcD
Datum:
13.07.2013 10:57:26
Views:
2199
Rating: Antwort:
  Ja
Thema:
Dateititel in Zelle schreiben anhand der Zelleneinträge

Hallo alle zusammen.
Ich habe ein haufen von xlsx Dateien, die ich über eine Sammelabfrage in ein Sheet kopiere.
Jetzt möchte ich vor jeden Eintrag, den Titel der jeweiligen Datei in die erste Spallte schreiben, also als Schleife.
Solange die in der importierten Datei einträge findest schreibe den Titel in A.
Die abfrage import alle Daten, die gefunden werden untereinander ab spalte B.


Public Sub CUSS_Daten_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
Dim fileToOpen As Variant
 
Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen damit dopplungen eleminiert werden
WBZ.Worksheets("CUSS_Daten").Range("A1:K65536").ClearContents
 
' letzter Eintrag TRUE = mehrere Dateien zulassen
varDateien = _
Application.GetOpenFilename("Datei (*.xlsx),*.xlsx", False, "Bitte gewünschte Datei(en) markieren", False, True)
 
' Abbruch
With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
End With
 
'Abgfrage und Import von xlsx Dateien und ab Spalte B sukzessive einfügen
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("A1:Z" & lngLastQ).Copy _
  Destination:=WBZ.Worksheets("CUSS_Daten").Range("B" & WBZ.Worksheets("CUSS_Daten").Range("A65536").End(xlUp).Row + 1)

WBQ.Close
Next
 
'Start
With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
End With
 
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
 
Exit Sub

'Errorhandling
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

Wie schon erwähnt, soll in Spalte A der Name der aktuell geöffneten Datei die unter varDateien eingetragen ist.
Bisher hatte ich entweder den Erfolg, dass er maximal einmal den Namen in A1 gespeichert hatte oder Excel den Namen von ActiveWorkBook genommen hat, dann aber auch nur in A1
Irgendwie steh ich gerade auf dem Schlauch wie ich mit ActiveWorkbook.Name das hinbekomme.

VG JcD

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Dateititel in Zelle schreiben anhand der Zelleneinträge
13.07.2013 10:57:26 JcD
NotSolved