Zelleninhalt von einer Tabelle in die andere kopieren
Hallo zusammen,
bin neu hier und probiere seit einiger Zeit mit Excel-Makros herum.
Mein Problem:
Ich nutze eine InputBox, um eine Tabelle zu befüllen; mit folgendem Code schreibe ich die Eingaben immer in die erste Freie Zeile:
Dim erste_freie_Zeile As Integer
erste_freie_Zeile = Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Row
Sheets("Tabelle1").Cells(erste_freie_Zeile, 1) = CDate(TextBox1.Text)
Sheets("Tabelle1").Cells(erste_freie_Zeile, 2) = Format(TextBox2.Text)
Sheets("Tabelle1").Cells(erste_freie_Zeile, 3) = Format(TextBox3, "#,##0.00")
Sheets("Tabelle1").Cells(erste_freie_Zeile, 4) = ComboBox1.Text
Dann vergleiche ich mit der INDEX-Funktion (nicht als VBA, sondern als Formel im Worksheet), ob ein bestimmter Wert bei einer bestimmten EINGABE = 1 ist oder nicht. Und falls ja, soll genau DIE betreffende Zeile in eine andere Tabelle kopiert werden.
INDEX(Tabelle2!B:B;VERGLEICH(Tabelle1!D2;Tabelle2!A:A))
Im Moment sieht der Code SO (hier mal nur für Spalte A; ich brauche auch noch B,C,D und G) aus:
If Cells(erste_freie_Zeile, 8) = "1" Then
MsgBox ("Treffer!")
Dim erste_freie_ZeileA As Integer
erste_freie_ZeileA = Sheets("Tabelle3").Range("A65536").End(xlUp).Offset(1, 0).Row
'Spalte A, erste eben eingetragene Zelle kopieren
With Sheets("Tabelle1")
.Range(Cells(erste_freie_Zeile, 1)).Select
.Selection.Copy
.Sheets("Tabelle3").Range(Cells(erste_freie_ZeileA, 1)).Select
.Selection.PasteSpecial Paste:=xlPasteValues
End With
End If
Das funktioniert aber nicht. Ich kriege bei der Zeile immer einen Laufzeitfehler.
Was mache ich falsch?
DANKE
bin neu hier und probiere seit einiger Zeit mit Excel-Makros herum.
Mein Problem:
Ich nutze eine InputBox, um eine Tabelle zu befüllen; mit folgendem Code schreibe ich die Eingaben immer in die erste Freie Zeile:
Dim erste_freie_Zeile As Integer
erste_freie_Zeile = Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Row
Sheets("Tabelle1").Cells(erste_freie_Zeile, 1) = CDate(TextBox1.Text)
Sheets("Tabelle1").Cells(erste_freie_Zeile, 2) = Format(TextBox2.Text)
Sheets("Tabelle1").Cells(erste_freie_Zeile, 3) = Format(TextBox3, "#,##0.00")
Sheets("Tabelle1").Cells(erste_freie_Zeile, 4) = ComboBox1.Text
Dann vergleiche ich mit der INDEX-Funktion (nicht als VBA, sondern als Formel im Worksheet), ob ein bestimmter Wert bei einer bestimmten EINGABE = 1 ist oder nicht. Und falls ja, soll genau DIE betreffende Zeile in eine andere Tabelle kopiert werden.
INDEX(Tabelle2!B:B;VERGLEICH(Tabelle1!D2;Tabelle2!A:A))
Im Moment sieht der Code SO (hier mal nur für Spalte A; ich brauche auch noch B,C,D und G) aus:
If Cells(erste_freie_Zeile, 8) = "1" Then
MsgBox ("Treffer!")
Dim erste_freie_ZeileA As Integer
erste_freie_ZeileA = Sheets("Tabelle3").Range("A65536").End(xlUp).Offset(1, 0).Row
'Spalte A, erste eben eingetragene Zelle kopieren
With Sheets("Tabelle1")
.Range(Cells(erste_freie_Zeile, 1)).Select
.Selection.Copy
.Sheets("Tabelle3").Range(Cells(erste_freie_ZeileA, 1)).Select
.Selection.PasteSpecial Paste:=xlPasteValues
End With
End If
Das funktioniert aber nicht. Ich kriege bei der Zeile immer einen Laufzeitfehler.
Was mache ich falsch?
DANKE
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 267631
Url: https://administrator.de/forum/zelleninhalt-von-einer-tabelle-in-die-andere-kopieren-267631.html
Ausgedruckt am: 23.04.2025 um 02:04 Uhr
2 Kommentare
Neuester Kommentar

Hallo Blimmo!
Unter der Annahme, dass sich der Code und die Steuerelemente in Tabelle1 befinden, ginge das in etwa so:
Grüße Dieter
Unter der Annahme, dass sich der Code und die Steuerelemente in Tabelle1 befinden, ginge das in etwa so:
Dim rngS As Range
Set rngS = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
rngS.Offset(0, 0).Value = CDate(TextBox1.Value)
rngS.Offset(0, 1).Value = TextBox2.Value
rngS.Offset(0, 2).NumberFormat = "#,##0.00"
rngS.Offset(0, 2).Value = CDbl(TextBox3.Value)
rngS.Offset(0, 3).Value = ComboBox1.Value
If rngS.Offset(0, 7).Value = 1 Then
MsgBox ("Treffer!")
'Copy ActiveSheet(A:D,G) nach Sheet3(A:E)
With Sheets("Tabelle3").Cells(Rows.Count, "A").End(xlUp)
Union(rngS.Resize(1, 4), rngS.Offset(0, 6)).Copy .Offset(1, 0)
End With
End If
Grüße Dieter