Office: Werte per VBA automatisch übertragen und fortlaufend speichern

Moin,
ich habe da mal eine bitte:
wie kann ich diesen Code dazu bringen von einer bestimmten Datei automatische Werte in eine andere Datei kopiert?
Ich kann zwar die Werte in derselben Tabelle übertrage, allerdings soll das ganze auf eine andere Datei übertragen wird. Dies soll geschehen, selbst wenn die Datei geschlossen ist.
Quelldatei: Neue Daten
Zieldatei Archive

Vielen Dank!
LG

Das ist der Code den ich momentan benutze:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Intersect(Target, Range("C6:C15"))
If Not Bereich Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
For Each Zelle In Bereich
If Zelle <> "" Then
Cells(Zelle.Row, "S") = Zelle
End If
Next Zelle
On Error GoTo 0
Application.EnableEvents = True

End If
End Sub

 

Die Datei muss geöffnet werden. Vorher prüfen ob auf.

Code:

    Dim BoOffen As Boolean
    Dim WoDatei As Workbook
    For Each WoDatei In Workbooks
        If WoDatei.Name = "test.xls" Then
            MsgBox "Datei ist schon geöffnet!"
            BoOffen = True
            Exit For
        End If
    Next
    If BoOffen = False Then
        MsgBox "Test wird automatisch geöffnet!"
        Workbooks.Open Filename:="C:\Eigene Dateien\Test.xls"
    End If

Workbook("MeineDatei.Xlsm").Worksheets("MeinTabelle").Cells(Zelle.Row, "S") = Zelle

 

Vielen Dank für den Code.
Der funktioniert soweit gut, allerdings habe ich zwei Probleme:
1. Jedes Mal, wenn ich etwas eingeben möchte, fragt er, ob die Datei geöffnet ist. Wie ich den Code ändern, dass er gar nicht fragt, sondern die Datei einfach öffnet?
2. der überträgt die Werte nicht in der an der Datei bzw. auf die Tabelle.
Könnte ich auch andere Zellen ansprechen und die Werte übertragen

Set Bereich = Intersect(Target, Range("C6:C15, D6:D15, E6:E16"))
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BoOffen As Boolean
Dim WoDatei As Workbook
For Each WoDatei In Workbooks
If WoDatei.Name = "Archive.xlsm" Then
MsgBox "Datei ist schon geöffnet!"
BoOffen = True
Exit For
End If
Next
If BoOffen = False Then
MsgBox "Test wird automatisch geöffnet!"
Workbooks.Open Filename:="C:\Users\Meine Datenquellen\Archive.xlsm"
End If
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Intersect(Target, Range("G23"))
If Not Bereich Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
For Each Zelle In Bereich
If Zelle <> "" Then
Workbooks("Neue Daten.Xlsm").Worksheets("Rücklauf").Cells(Zelle.Row, "S6:S15,T6:T15, U6:U15") = Zelle

End If
Next Zelle
On Error GoTo 0
Application.EnableEvents = True

End If
End Sub


Vielen Dank!

 

Set Bereich = Intersect(Target, Range("C6:C15, D6:D15, E6:E16"))
diese Zeile funktioniert nicht ausserhalb von Worksheet_Change()

das ist ebenfalls Murks. .Cells(Zelle.Row, "S6:S15,T6:T15, U6:U15")
Cells(Zeile , Spalte) Cells hat nur 2 Parameter. Und das sind die Koordinaten Zeile und Spalte.
das wäre die passende Codepassage.
....Range(Zelle.Address) =Zelle

 

es sollte in Spalte "S"
Du schreibst in Spalte C

Gruß Hajo

 

@Hajo, und? kein Lösungsvorschlag?
Range(Zelle.Address).offset(0,16) = Zelle

 

die Lösungv Stand im ersten Beitrag, das muss ich nicht wiederholen.

<a href="Homeseite - Hajo's Excelseiten" target="_blank" title="Hajo&#039;s Excelseiten">Gruß Hajo</a>