VBA: Quelldateien schließen

[Ergil]

Hallo zusammen,

ich habe mit meinen beschränkten VBA-Kenntnissen und dem Tool "Makro Aufzeichnen" irgendwie drei halbwegs funktionierende Makros gebaut.

Die Idee war: es gibt unterschiedliche Dateien die unterschiedliche Namen haben können (aber nicht müssen) und/oder deren Dateipfad unterschiedlich ist.
Excel sollte nun die Daten in eine Datei importieren, damit ich das nicht händisch jedesmal rüberkopieren muss.

Soweit, sogut. Klappt auch alles Prima. Nur:
Es kann vorkommen, dass die Quelldatei den gleichen Namen hat, wie eine vorherige Quelldatei (da auch die Datenquelle identisch ist, nur der Inhalt ist ein anderer).
Dann funktioniert das Makro auch nicht richtig, da im Hintergrund die Quelldatei (noch) geöffnet ist.

Ich habe jetzt schon einige Befehle die ich bei google gefunden habe ausprobiert, um das Problem zu lösen, aber offenbar bin ich zu doof dafür.

Um mein Problem zu veranschaulichen, hier nochmal Klartext:

Die Quelldatei trägt meinetwegen den Namen "Objects.xlsx". Ich rufe über eines meiner Makros die Datei auf, der Inhalt der Objects.xlsx wird in die aktive Tabelle kopiert und ggf. umformatiert.
Wenn ich den vorgang dann abschließe und eine neue "Objects.xlsx" auswähle um damit den Vorgang zu wiederholen, aber die alte "Objects.xlsx" noch offen ist, kopiert er aus einer anderen Tabelle die Daten herüber, aber aus keiner "Objects.xlsx" weder der alten noch der aktuellen.

Mein Wunsch ist, dass nach dem Rüberkopieren der Daten die Quelldatei automatisch geschlossen wird, sodass ich das Makro sofort für eine andere Datei verwenden kann, ohne dafür erst zick Fenster zu schließen, die sich bei der Benutzung des Makros geöffnet haben.

Ich habe darüber hinaus unterschiedliche Codes für unterschiedliche Dateien und Formate:

Hier mein CSV-Import:

Code:

Sub Quelldatei_auswählen()

Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung


 Dim i&, n&
 Dim Zeile As String
 Dim Ergebnis As Variant
 Dim DateiName As Variant
 DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
 If DateiName <> False Then
   i = 1
   Open DateiName For Input As #1
   Do While Not EOF(1)
     Line Input #1, Zeile
     Ergebnis = Split(Zeile, ";")
     For n = 0 To UBound(Ergebnis)
       Cells(i, n + 1) = Ergebnis(n)
     Next
     i = i + 1
   Loop
   Close #1
 End If

   Cells.Select 'Wähle alle Zellen aus
   Selection.Copy
Worksheets(1).Range("1:1048576").Copy 'kopiere alles zur Zieldatei




Ziel.Worksheets(1).Activate 'wechselt zur Zieldatei zurück
Ziel.Worksheets(1).Range("1:1048576").PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False 'setzt Zwischenablage in Datei ein

Worksheets(1).Cells(1, 1).Select 'zeigt Zieldatei wieder an

'Hier können die gewünschten Sonderzeichen entfernt werden:

   Columns("A:A").Select
   Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False 'entfernt Sonder- und Leerzeichen
       

End Sub

Und hier der andere Code für eine Datei, die Systembedingt umformatiert, aber wieder zurückformatiert werden muss (aus XLS[X]):

Code:

Sub Fehlerliste_Waehlen()

Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung

Application.Dialogs(xlDialogOpen).Show 'öffne Quelldatei
   Cells.Select
   Selection.Copy
Worksheets(1).Range("1:1048576").Copy 'kopiere alles zur Zieldatei

Ziel.Worksheets(1).Activate 'wechselt zur Zieldatei zurück
Ziel.Worksheets(1).Range("1:1048576").PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False 'setzt Zwischenablage in Datei ein

Worksheets(1).Cells(1, 1).Select 'zeigt Zieldatei wieder an
'Hier findet die Umformatierung statt:
[...]
   Range("B2").Select

End Sub

Dieser Code ist für eine gänzlich andere Datei:

Code:

Sub Bestandsdatei_Auswaehlen()

Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung

Application.Dialogs(xlDialogOpen).Show 'öffne Quelldatei
   Cells.Select
   Selection.Copy
Worksheets(1).Range("1:1048576").Copy 'kopiere alles zur Zieldatei
'ActiveWindow.Close

Ziel.Worksheets(2).Activate 'wechselt zur Zieldatei zurück
Ziel.Worksheets(2).Range("1:1048576").PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False 'setzt Zwischenablage in Datei ein

Worksheets(2).Cells(1, 1).Select 'zeigt Zieldatei wieder an

'CSV-Trenner (wird derzeit nicht verwendet):
'    Columns("A:A").Select
'    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
'        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
'        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
'        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
'        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
       TrailingMinusNumbers:=True

'Sonderzeichen entfernen:
   Columns("A:A").Select
   Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False



End Sub

Meine Bitte an der Stelle:
An welcher Stelle muss ich welchen Befehl eingeben, damit die jeweilige Quelldatei geschlossen wird?
Schön wäre, wenn alle kopierten Werte in der Zwischenablage verbleiben, auch, wenn die Quelldatei bereits geschlossen wurde (falls das machbar ist), wäre aber auch OK falls das nicht geht.

Ich hoffe ihr habt eine einigermaßen unkomplizierte Lösung für mich.

Vielen Dank!

[mmat]

Hallo,

zu dem Code gäbe es noch einiges zu sagen, nur soviel: warum liest du die CSV-Daten nicht gleich in die "ZIEL"-Tabelle, sondern kopierst die erst aus einer Zwischendatei ???

Um die Frage zu beantworten, ich hab mal 3 Zeilen ergänzt (und eine gestrichen), ich hoffe du verstehst was gemeint ist:

Code:

Sub Quelldatei_auswählen()
  Dim Ziel As Workbook, Temp As Workbook
  Set Ziel = ThisWorkbook
  Dim i&, n&
  Dim Zeile As String
  Dim Ergebnis As Variant
  Dim DateiName As Variant
  DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
  If DateiName <> False Then
    Set Temp = Workbooks.Add 'ergänzt
    i = 1
    Open DateiName For Input As #1
    Do While Not EOF(1)
      Line Input #1, Zeile
      Ergebnis = Split(Zeile, ";")
      For n = 0 To UBound(Ergebnis)
        Cells(i, n + 1) = Ergebnis(n)
      Next
      i = i + 1
    Loop
    Close #1
  Else 'keine csv-Datei ausgewählt
    Exit sub
  End If

  Cells.Select
  Selection.Copy
  'Worksheets(1).Range("1:1048576").Copy 'Überfüssig und syntaktisch unklar
  Ziel.Worksheets(1).Activate
  Ziel.Worksheets(1).Cells(1, 1).Paste 'geändert
  Application.CutCopyMode = False
  Temp.Close False 'ergänzt
  Worksheets(1).Cells(1, 1).Select
  'Ab hier entfernen bestimmter Zeichen, wie bisher
  '...
End Sub

vg, MM