Info finden, ausschneiden & Quellzeile löschen

Forumthread: Info finden, ausschneiden & Quellzeile löschen

09.07.2018 11:15:22

Christian

Hallo zusammen!
Ich würde gerne den Inhalt von Zelle A1 & B1 (Eingabe-Tabelle) innerhalb einer Quell-Tabelle suchen, dann die komplette Zeile (beide Informationen sind immer in der gleichen Zeile) ausschneiden und in eine neue Tabelle - Ziel-Tabelle - an die nächste freie Stelle setzen.
Zum Schluss soll noch die ausgeschnitte Zeile der Quell-Tabelle gelöscht werden.
Ausschneiden als Werte (keine Formatierung, keine Formeln)
Falls das Ausschneiden einer ganzen Zeile kein gutes Vorhaben ist (Performance) dann
würde auch Inhalt Spalte A:F dieser gefundenen Zeile reichen.
Anbei eine Beispieldatei.
In dieser sind auch Bilder des Wunsch-Endergebnisses enthalten, um nochmals einen besseren Einblick zu erhalten.
https://www.herber.de/bbs/user/122564.xlsx
Im Voraus vielen Dank für eure mögliche Unterstützung!
Viele Grüße,
Christian

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW:Frage

09.07.2018 11:37:45

hary
AW: AW:Frage

09.07.2018 11:52:51

Christian
AW:mit find next

09.07.2018 12:12:51

hary
AW: kleine Korrektur

09.07.2018 12:17:32

hary
AW: kleine Korrektur

09.07.2018 12:32:49

Christian

AW:Frage

09.07.2018 11:37:45

hary

Moin
Kann es vorkommen dass die Namen, in Blatt "Quelle" SpalteA, mehr als einmal vorkommen?
gruss hary
gruss hary

AW: AW:Frage

09.07.2018 11:52:51

Christian

Hallo Hary,
also der Inhalt Spalte A (Quell-Tabelle) kommt häufiger vor, die Kombination mit Spalte B dann nur einmalig.
Sorry, das habe ich vergessen anzugeben.
Danke für dein Interesse!
Viele Grüße,
Christian

AW:mit find next

09.07.2018 12:12:51

hary

Moin

Sub nachZielblatt()
Dim wksQ As Worksheet, wksZ As Worksheet, wksE As Worksheet
Dim zelle As Range
Set wksE = Worksheets("Eingabe")
Set wksQ = Worksheets("Quelle")
Set wksZ = Worksheets("Ziel")
Dim strTitel As String
Dim firstAddress As String
Set zelle = wksQ.Columns(1).Find(What:=wksE.Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not zelle Is Nothing Then
firstAddress = zelle.Address
Do
If zelle.Offset(0, 1) = wksE.Cells(1, 2) Then
wksZ.Cells(wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 6).Value =  _
zelle.Resize(1, 6).Value
zelle.EntireRow.Delete
Exit Do
End If
Set zelle = wksQ.Columns(1).FindNext(zelle)
Loop While zelle.Address  firstAddress
Else
MsgBox "Nicht gefunden"
End If
Set wksQ = Nothing
Set wksZ = Nothing
Set wksE = Nothing
Set zelle = Nothing
End Sub

gruss hary

AW: kleine Korrektur

09.07.2018 12:17:32

hary

Moin
Die Codezeile:
Dim strTitel As String
kann raus.
gruss hary

AW: kleine Korrektur

09.07.2018 12:32:49

Christian

Hi Hary,
Wahnsinn, wie schnell Ihr Profis hier die Codes schreiben könnt :-O.
Es funktioniert ohne Probleme, super Sache!!!
Vielen Dank für die wirklich sehr schnelle Hilfe!
Viele Grüße,
Christian

Beliebteste Forumthreads (12 Monate)

Info finden, ausschneiden & Quellzeile löschen

Forumthread: Info finden, ausschneiden & Quellzeile löschen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread