Clever-Excel-Forum

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!

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

Ergil

mmat