Excel VBA Makro "suchen und kopieren" an
11.05.2021 12:43:59
Beamter
Der Code erfüllt folgendes:
Es erscheint eine Eingabeaufforderung
Er sucht in "Tabellenblatt A" in "Spalte A" einen Wert, z.B. "ID-020"
Er kopiert die Zeile in "Tabellenblatt B" in Zeile zwei
Er löscht die Zeilen vor dem einfügen (aber das ist auch ein Problem)
Problem:
Im Ziel "Tabellenblatt B"werden alle Zeilen unterhalb "Zeile 1" gelöscht
Schlecht: Hier stehen aber "Steuerelemente" und "Text"
außerdem:
Ich bräuchte eigentlich nicht die ganze Zeile von "A" bis ":Z" kopieren.
Es würden die Werte von vier Spalten reichen.
Anpassung:
Ich brauche nicht die ganze Zeile kopiert
Aus der Quelle werden eigentlich nur vier Zellenwerte der Zeile, also "Ticket-ID" (A+Zeile"), "Ticket-Bezeichnung" (D+Zeile) , "Datum" (S+Zeile) und "PT" (Z+Zeile)) benötigt
Am Ziel sollen die Werte in 4 feste Zellen eingetragen werden A1, A2, A3, A4, in Zeile zwei
Wichtig wäre mir aber, dass im Ziel immer nur die Inhalten der zweiten Spalte gelöscht werden, die dann überschrieben werden
Code-Link
http://www.excel-ist-sexy.de/suchen-und-kopieren-1/
Ausführliche Beschreibung
Ich möchte eine Ticket-ID (Namen "ID-001" bis "ID-999") in einer Spalte der Tabelle 1 (Quelle) suchen.
Suchbegriff z.B. "ID-020"
Einige Zellenwerte dieser Zeile des Datensatzes ("Ticket-ID", "Ticket-Bezeichnung", "Datum" und PT") sollen in die Zeile 2 des Tabellenblatt4 (Ziel) kopiert werden. Zeile 1 ist sind die Überschriften.
Ab dann verarbeite ich die Werte mit weiteren Makros weiter.
Problem
Unterhalb Zeile 2 ist ein Bereich mit Textfelder, Buttons mit denen ich die vier Felder weiterverarbeite (Word Dokument, Email mit Betreffzeile).
Code:
Sub suchenundkopieren()
Dim rngSuch As Range, wksSrc As Worksheet, wksDst As Worksheet
Dim strSuch As String, rngFound As Range
Dim strFirst As String, FoundAdr As String
Dim ZeSrc As Integer, ZeDst As Integer, lRow As Long, lRowDst As Long
' "rw1" ist eine Variable die einen Wert aufnehmen soll
'"Cells" verweist auf die Zellen
'"Rows.Count" ist eine Funktion welche die Anzahl Zeilen im Tabellenblatt zurückgibt ( = 65536)
'",1" in welcher Spalte gesucht werden soll ( hier A)
'".End" weisst EXCEL an, dass es dort beginnen soll zu zählen
'"xlUp" ist die Richtung in welche EXCEL suchen soll
'".Row" gibt die erste zeile von unten zurück, wo etwas drinsteht
Set wksSrc = Tabelle1 'Wo wird gesucht(Aufwandsschaetzungen)
Set wksDst = Tabelle15 'Ziel (Auftragserteilungen)
lRow = wksSrc.Cells(Rows.Count, 1).End(xlUp).Row
Set rngSuch = wksSrc.Range("A1:B" & lRow) 'Ticket-ID suchen
With wksDst
lRowDst = WorksheetFunction.Max(2, .Cells(Rows.Count, 1).End(xlUp).Row)
wksDst.Range("A2:B" & lRowDst).EntireRow.Delete 'Alle Namen-Eintraege loeschen
If .Range("A1") = "" Then 'Wichtig, damit in A1 etwas steht (eventuell anpassen)
.Cells(1, 1) = "1"
.Cells(1, 2) = "2"
.Cells(1, 3) = "3"
.Cells(1, 3) = "4"
End If
End With
strSuch = InputBox("Bitte Ticket-ID eingeben", "Filter") 'Text Eingabe-Dialog
With rngSuch
Set rngFound = .Find(what:="ID-" & strSuch) 'sucht alle begriffe; vorgegeben ist ID-
If Not rngFound Is Nothing Then
strFirst = rngFound.Address
Do
FoundAdr = rngFound.Address
ZeSrc = rngFound.Row
ZeDst = wksDst.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksSrc.Range("A" & ZeSrc & ":z" & ZeSrc).Copy wksDst.Cells(ZeDst, 1) 'Welcher Bereich wird kopiert
Set rngFound = .FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address strFirst
Else
MsgBox "Der Name '" & strSuch & "' wurde nicht gefunden!", vbInformation, "Fehleingebe?"
End If
End With
End Sub