Excel VBA - Nach kopieren anderen Zelleninhalt "zurückwerfen"?
Hallo,
ich habe eine Formularseite gebastelt, bei der eingegebene Daten in eine Liste eingefügt werden. Nun möchte ich, dass das Makro, welches die Daten in das andere Blatt in eine neue Zeile kopiert hat, auf der Formularseite die Zeilennummer in ein Feld einträgt.
Die Eingabeseite heißt "Eingaben" und das Blatt mit der Liste heißt "Liste"
Beispiel:
Ich gebe Daten ein, klicke den Button an auf dem das Makro liegt, und die Daten werden nach "Liste" in Zeile 10 kopiert (während Zeilen 5-9 schon Daten enthalten aus vorherigen Übertragungen).
In dem selben Makro soll nun am Ende die Nummer, die in A10 steht (In Zeile A stehen von mir eigens vergebene Nummern), auf der Eingabeseite in das Feld B10 kopiert werden.
Anders formuliert:
Spalte A (Lliste) enthält Reklamationsnummern, fortlaufend. Beginnend mit RK20220001.
Wenn ich jetzt in der "Eingaben"-Seite meine Daten erfasse und das Makro nutze, werden die eingegebenen Daten in die "Liste" kopiert. Es wird automatisch immer die letzte Zeile gefüllt, ab Spalte B.
Nun möchte ich, dass die Reklamationsnr., die neben den zuletzt eingefügten Daten steht, in das "Eingaben"-Blatt in das Feld B10 kopiert wird.
Denn die Eingabefelder sind bereits so formatiert, dass man ein Etikett drucken kann, das dann an die Ware kann. Damit man nicht immer manuell die Nummer raus suchen muss, soll sie halt automatisch dort rein.
2 Antworten
Habe ich so richtig verstanden:
Du hast eine Formularseite (als Etikett formatiert):
Und eine Liste, in der Zeile/Spalte vertauscht sind:
Ich würde Laden und Speichern mit 2 Buttons und 2 Makros trennen. Der Code:
Sub speichern()
On Error Resume Next 'Fehler ignorieren
Nummer = Sheets("Formular").Range("B1")
n = 0: n = Sheets("Liste").Range("A:Z").Find(Nummer).Row 'sucht die Nummer
'wenn sie gefunden wird, wird der Datensatz überschrieben,
'falls sie nicht gefunden wird, wird der Datensatz in die erste freie Zeile geschrieben:
If n = 0 Then n = Sheets("Liste").Cells.SpecialCells(xlLastCell).Row + 1
For Zeile = 1 To 4
Sheets("Liste").Cells(n, Zeile) = Sheets("Formular").Cells(Zeile, 2)
Next Zeile
End Sub
Sub laden()
On Error Resume Next 'Fehler ignorieren
Nummer = Sheets("Formular").Range("B1")
n = 0: n = Sheets("Liste").Range("A:Z").Find(Nummer).Row 'sucht die Nummer
If n = 0 Then MsgBox ("Nummer " & Nummer & "wurde nicht gefunden"): End
For Zeile = 1 To 4
Sheets("Formular").Cells(Zeile, 2) = Sheets("Liste").Cells(n, Zeile)
Next Zeile
End Sub
aha, dann probiere mal das:
Sub speichern()
On Error Resume Next 'Fehler ignorieren
For n = 1 To 99999 'suche in der Liste die 1. freie Zeile
If Sheets("Liste").Cells(n, 2) = 0 Then Exit For
Next n
For Zeile = 4 To 6 'schreibe die Formularzeilen 4-6 in die Listenspalten 2-4
Sheets("Liste").Cells(n, Zeile - 2) = Sheets("Formular").Cells(Zeile, 2)
Next Zeile
'Hole die Nummer aus der Liste in das Formular
Sheets("Formular").Range("B10") = Sheets("Liste").Cells(n, 1)
End Sub
Angenommen, die Variable in Deinem Makro, die die erste freie Zeile in "Liste" angibt heißt:
lngFreieZeile
Dann kannst Du mit:
Sheets("Eingaben").Range("B10") = Sheets("Liste").Cells(lngFreieZeile, 1).Value
den Wert aus der Spalte A nach B10 schreiben.
Habe ich Dich richtig verstanden? Hilft Dir das?
Der Code sieht so aus:
Sub transfer_werte()
Dim rngDaten1 As Excel.Range
Dim rngDaten2 As Excel.Range
Set rngDaten1 = Worksheets("Eingaben").Range("B4:B9")
Set rngDaten2 = Worksheets("Eingaben").Range("E4:E6")
With Worksheets("Liste")
With .Cells(.Rows.Count, 2).End(xlUp)
.Offset(1, 0).Resize(rngDaten1.Columns.Count, rngDaten1.Rows.Count).Value = Application.Transpose(rngDaten1.Value)
End With
End With
With Worksheets("Liste")
With .Cells(.Rows.Count, 8).End(xlUp)
.Offset(1, 0).Resize(rngDaten2.Columns.Count, rngDaten2.Rows.Count).Value = Application.Transpose(rngDaten2.Value)
End With
End With
End Sub
Im Anschluß an diesen Kopiervorgang soll ein Code kommen, in der Art: "Suche letzten Eintrag in "Liste" Spalte B und kopiere die Zelle links davon (also aus Spalte A) und füge diese in "Eingabe" Zelle B10 ein"
Ich versuche das mal als "Trockenübung", also ohne es in Excel auszuprobieren:
Sub transfer_werte()
Dim rngDaten1 As Excel.Range
Dim rngDaten2 As Excel.Range
Dim lngFreieZeile '############
Set rngDaten1 = Worksheets("Eingaben").Range("B4:B9")
Set rngDaten2 = Worksheets("Eingaben").Range("E4:E6")
With Worksheets("Liste")
With .Cells(.Rows.Count, 2).End(xlUp)
lngFreieZeile = .Row + 1 '###############
.Offset(1, 0).Resize(rngDaten1.Columns.Count, rngDaten1.Rows.Count).Value = Application.Transpose(rngDaten1.Value)
End With
End With
With Worksheets("Liste")
With .Cells(.Rows.Count, 8).End(xlUp)
.Offset(1, 0).Resize(rngDaten2.Columns.Count, rngDaten2.Rows.Count).Value = Application.Transpose(rngDaten2.Value)
End With
End With
Sheets("Eingaben").Range("B10") = Sheets("Liste").Cells(lngFreieZeile, 1).Value '##############
End Sub
Die drei Zeilen, die ich eingefügt habe, habe ich mit ### markiert.
Falls es mit der Zeile nicht genau hinhaut versuche mal das +1 wegzulassen oder auf +2 zu erhöhen.
Das geht leider so nicht. Es ist zwingend erforderlich, dass der Wert mit dem selben Makro eingefügt wird. Denn es hängen noch weitere Funktionen in der Tabelle, die sonst nicht mehr funktionieren würden.
Das Eingabeformular, dass gleichzeitig als Label gedruckt wird sieht so aus (gekürzte Fassung):
(von A4 + B4 bis A6 + B6)
Datum: 01.10.2021
KDNr: 123456
Name: Max Mustermann
Diese Daten werden in die Liste eingefügt von B5-D5 (mit jeder weiteren Eingabe entsprechend nach unten dann.
In der Liste ist in Spalte A die ReklaNr bereits vorgegeben, die dann nach dem Kopiervorgang zu dem neuen Eintrag gehört.
Diese ReklaNr. Muss dann in der ersten Mappe in Feld B10 eingefügt werden.
Ich benötige etwas in der Art: "Suche letzten Eintrag in "Liste" Spalte B und kopiere die Zelle links davon (also Spalte A) und füge diese in "Eingabe" Zelle B10 ein"
Leider weiss ich nicht wie das mit den Bildern hier einfügen geht :(