Supportnet / Forum / Tabellenkalkulation

Hallo Allerseits, ich arbeite mit einem Makro, das Daten aus einer Datei in eine andere Datei schreibt. Mein Problem ist, dass der Dateiname der Zieldatei sich ändern kann und ab einer Änderung natürlich nicht mehr von dem Makro angesprochen werden kann. Wie kann man eine Abfrage integrieren, durch die man zu Beginn den aktuellen Dateinamen abfragen kann? Hier das Makro für das Kopieren verschiedener Zellbereiche. Wer kann mir helfen? Range("A2:C2").Select Selection.Copy Windows("SHIP ACCOUNTING.xls").Activate Sheets("CREW_DATA").Select Range("C3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Contracts of Employment.xls").Activate Range("E2:L2").Select Selection.Copy Windows("SHIP ACCOUNTING.xls").Activate Range("G3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Contracts of Employment.xls").Activate Range("M2").Select Selection.Copy Windows("SHIP ACCOUNTING.xls").Activate Range("U3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Contracts of Employment.xls").Activate Range("N2").Select Selection.Copy Windows("SHIP ACCOUNTING.xls").Activate Range("X3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Contracts of Employment.xls").Activate Range("O2").Select Selection.Copy Windows("SHIP ACCOUNTING.xls").Activate Range("AB3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E3").Activate Windows("Contracts of Employment.xls").Activate Range("A20").Activate

Hi Daniel,

frage beim Öffnen der Arbeitsmappe deren Namen ab und lege ihn in einer in einem allgemeinen Modul als Public deklarierten Variablen ab.

Tipps:
- die Arbeitsmappe, in der der Code steht, kannst du mit ThisWorkbook ansprechen
- in VBA kann man in vielen Fällen auf Select verzichten. Schreibe z.B. anstelle

 Range("M2").Select
Selection.Copy

einfacher

 Range("M2").Copy

Dadurch wird der Code zum einen kürzer und zum anderen schneller, da Select und Activate den Code ausbremsen.

Bis später,
Karin

Hallo Karin,

leider bin ich erst seit kurzem dabei, mit Makros zu arbeiten.

Daher ist mir leider nicht genau klar, wie man eine solche Variable deklarieren muss.

Ich stelle mir eine Lösung so vor, dass ich im Makro statt des Dateinamens eine Variable definiere, die sich auf den Inhalt einer bestimmten Zelle bezieht, so dass ich den aktuellen Dateinamen zu Beginn in diese Zelle schreiben kann.

Das Problem ist nur der Weg der "Programmierung".

Vielleicht kannst Du mir den String nennen?

Hi Daniel,

schreibe an den Anfang deines Code folgende 2 Zeilen

Dim strMappe As String
strMappe = Worksheets("Tabelle1").Range("A1")

Damit übergibst du den Wert in Zelle A1 der Tabelle1 an die Variable. Vergiss aber nicht das ".xls" beim Dateinamen in A1.

Bis später,
Karin

Hi Daniel,
wenn in dem Moment, in dem das Makro laufen soll, nur die Quell- und die Zieldatei geöffnet sind, dann wird obiges nicht benötigt. Es genügt:

ActiveWindow.ActivateNext

um zwischen den Dateien hin und her zu wechseln.
mfg
woher

Hi Daniel,

wie bereits in meinem ersten Beitrag erwähnt, kann man zu 99% auf Select und Activate verzichten. Hier geht es sogar zu 100% ;-)

Sub daten_übertragen()
    Dim wbMappe1 As Workbook
    Dim wbMappe2 As Workbook
    Dim wsTabelle As Worksheet
    Dim strMappe As String
    Dim inSpalte As Integer
    strMappe = ThisWorkbook.Worksheets("Tabelle1").Cells(1, 1)
    Set wbMappe1 = ThisWorkbook
    Set wbMappe2 = Workbooks(strMappe)
    Set wsTabelle = wbMappe1.Worksheets("Tabelle1")
    With wbMappe2.Worksheets("CREW_DATA")
        For inSpalte = 1 To 12
            If inSpalte <> 4 Then .Cells(3, inSpalte + 2) = wsTabelle.Cells(2, inSpalte)
        Next inSpalte
        .Cells(3, 21) = wsTabelle.Cells(2, 13)
        .Cells(3, 24) = wsTabelle.Cells(2, 14)
        .Cells(3, 28) = wsTabelle.Cells(2, 15)
    End With
End Sub

Dabei steht in Tabelle1 Zelle A1 (musst du evtl. anpassen) der Arbeitsmappe mit dem Code der Name der Arbeitsmappe, in die du die Daten übertragen willst.

Bis später,
Karin

Vielen Dank für die schnelle Hilfe (auch bei meiner anderen Anfrage).

Hallo Allerseits,

Mittlerweile habe ich weitere kompetente Hilfe erhalten, nun gibt es ein mweiteres Problem, bei dem ich um Hilfe bitte:

Ich möchte Daten aus einer Datei in eine andere kopieren. Leider erhalte ich folgende Fehlermeldung beim ersten Aufruf der Zieldatai (Windows("Zieldatei").Activate):

Index außerhalb des gültigen Bereichs. Laufzeitfehler 9.

Vielen Dank im voraus.

Sub Data_Transfer()
Dim Quelldatei$, Zieldatei$

Quelldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Quelldatei auswählen...")
Zieldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Zieldatei auswählen...")

If Dir(Quelldatei) = "" Or Dir(Zieldatei) = "" Then Exit Sub

If Dir(Quelldatei) <> "" And Dir(Zieldatei) <> "" Then
Sheets("INTERFACE").Activate
Range("A9:C18").Copy
Windows("Zieldatei").Activate
Sheets("CREW_DATA").Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("E9:L18").Copy
Windows("Zieldatei").Activate
Range("G3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("M9:M18").Copy
Windows("Zieldatei").Activate
Range("U3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("N9:N18").Copy
Windows("Zieldatei").Activate
Range("X3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("O9:O18").Copy
Windows("Zieldatei").Activate
Range("AB3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Activate
Windows("Quelldatei").Activate
Range("A20").Activate
End If

End Sub

MfG
Daniel

Hallo Daniel,

kannst Du mir mal verraten, warum Du zu dem gleichen Thema einen weiteren Thread aufmachst. Wir alle arbeiten hier im Moment aneinander vorbei. Ich habe Dir eine eine neue Lösung in dem alten Therad gepostet. Unterlasse es bitte in Zukunft zu gleichen Fragen mehrere Beiträge zu eröffnen.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,

ja Entschuldigung, Du hast natürlich Recht.