Supportnet / Forum / Tabellenkalkulation

Hallo, ich bin es wieder einmal und brauch nun mal wieder die Hilfe von euch. Also folgendes Problem: Ich habe zwei verschiedene Mappen ( Test1 und Test2), nun soll aus der einen Mappe ( Test1,Tabelle 1 ) Daten in die andere Mappe ( Test2, Tabelle 1 ) übertragen werden, das Problem ist das in der Mappe Test1 die Eingaben wieder gelöscht werden, deswegen sollen die Daten von Test1Tabelle 1 nach Test2 Tabelle 1übertragen werden und abgespeicht werden. Es sind folgende Zellen die übertragen werden sollen: Test1: B7;C1;F3;F44 Es müßte so ausschauen: Test1 Test2 B7 steht dann in E3 C1 steht dann in C3 F3 steht dann in D3 F44 steht dann in B3 Dann müßte Test2 gespeichert werden da ja in Test1 die Werte gelöscht werden. Nun müßte das Makro die neuen Eingaben logischer weiße ja nicht in die Zeile 3 schreiben sondern in die Zeile 4 und das ganze geht bis zur Zeile 38. Ich hoffe das ich mich klar genug ausgedrückt habe was ich erreichen will. Gruß Achim

Hallo,

wenn ich das richtig verstanden habe, dann sollen die Eintragungen von Test1 sozusagen immer um eine Zeile nach unten verschoben werden (in Test2).
Probier mal:

Sub übertragen()
Dim name As String

Application.Screenupdating = False
Rem Dateipfad von Test2:
name = "D:\Eigene Dateien\Test2.xls"
Workbooks.Open Filename:=name
Rem Nach unten schieben:
Workbooks("Test2.xls").Sheets("Tabelle1").Range("B3:E3").Insert Shift:=xlDown
Rem Übertragen:
Workbooks("Test2.xls").Sheets("Tabelle1").Range("E3").Value = Workbooks("Test1").Sheets("Tabelle1").Range("B7").Value
Workbooks("Test2.xls").Sheets("Tabelle1").Range("C3").Value = Workbooks("Test1").Sheets("Tabelle1").Range("C1").Value
Workbooks("Test2.xls").Sheets("Tabelle1").Range("D3").Value = Workbooks("Test1").Sheets("Tabelle1").Range("F3").Value
Workbooks("Test2.xls").Sheets("Tabelle1").Range("B3").Value = Workbooks("Test1").Sheets("Tabelle1").Range("F44").Value
Rem Test2 speichern u. schliessen:
Workbooks("Test2.xls").Save
Workbooks("Test2.xls").Close
Application.Screenupdating = True
End Sub

Den Dateipfad von Test2 musst du noch angleichen !
Vielleicht ist es das oder du kannst es zum Umbauen nutzen.

Gruss

Ich glaube doch eher so: Leere Zeile suchen u. dort die Werte entsprechend eintragen (Bis Zeile 38):

Sub übertragen()
Dim name, Ende, Bereich

Application.Screenupdating = False
name = "D:\Eigene Dateien\Excel-Dateien\Verschiedene Excel(VBA)-Programme\Datenübertragung von Datei zu Datei\Test2.xls"
Workbooks.Open Filename:=name
Ende = Workbooks("Test2.xls").Sheets("Tabelle1").Range("B38").End(xlUp).Offset(1, 0).Row
Workbooks("Test2.xls").Sheets("Tabelle1").Cells(Ende, 5) = Workbooks("Test1").Sheets("Tabelle1").Range("B7").Value
Workbooks("Test2.xls").Sheets("Tabelle1").Cells(Ende, 3) = Workbooks("Test1").Sheets("Tabelle1").Range("C1").Value
Workbooks("Test2.xls").Sheets("Tabelle1").Cells(Ende, 4) = Workbooks("Test1").Sheets("Tabelle1").Range("F3").Value
Workbooks("Test2.xls").Sheets("Tabelle1").Cells(Ende, 2) = Workbooks("Test1").Sheets("Tabelle1").Range("F44").Value
Workbooks("Test2.xls").Save
Workbooks("Test2.xls").Close
Application.Screenupdating = True
End Sub

Am besten beide ausprobieren. Eine Möglichkeit wird schon passen.

Gruss

Hallo Ahnan,

erst mal danke für deine Hilfe, also die zweite Lösung ist genau das was ich erreichen wollte.
Vielen Dank du hast mir wirklich sehr weiter geholfen.
Ich finde es echt super was ihr da macht und ich lerne immer mehr dazu.


Gruß und schönen Abend
Achim

• Werte der aktiven/markierten Zeile auf 2. Tabellenblatt einfügen
• Werte in nächste leer Zeile einer zweiten Datei übertragen
• VBA Werte finden uns kopieren ???
• überschrift erzeugen
• zeile einfügen