dynamisches Löschen und Kopieren

Guten Morgen zusammen,
ich bräuchte mal Hilfe mit einem VBA-Code. Da ich noch blutiger Anfänger bin, bin ich etwas überfordert. Anbei habe ich eine Beispielsdatei hochgeladen.
Links in A1(gelb makiert) ist in der Zelle ZE geschrieben. Ich möchte die Spalten C1 bis BQ 1 nach ZE durchsuchen. Das ZE taucht beispielsweise nun in Zelle K1 auf. Als nächstes möchte ich dann erreichen, dass es mir die Werte rechts davon löscht. Quasi das Gelb makierte.
Unten drunter ist eine Datenreihe die mit ZE beginnt und mit O70 Weiterläuft. Diese würde ich gerne an die gelöschte Stelle kopieren. Das Endergebnis ist dann ganz unten mal händisch zusammen geführt.
Mein großes Problem ist, dass sich das ZE nicht immer in Spalte K1 befindet. Demnach kann ich nicht die O70 durch kopieren und einfügen anhängen.
Ich habe mal angefangen mit einem Code, aber komme gerade absolut nicht weiter. Es wäre toll wenn ich Unterstützung bekommen würden.
Vielen Dank im Voraus :-)
Sub FindString()
Dim c As Range
Dim firstAddress As String
With Worksheets(1).Range("A1")
Set c = .Find("abc", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
https://www.herber.de/bbs/user/157560.xlsx
Gruß
Luka

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim strSuchtext As String Dim lngSuchzeile As Long, lngSuchspalte As Long Dim lngFindzeile As Long, lngFindspalte As Long With Worksheets("Tabelle1") strSuchtext = .Range("A1") lngFindspalte = Application.Match(strSuchtext, .Rows(1).EntireRow.Resize(1, .Columns.Count - 1).Offset(0, 1), 0) + 2 lngFindzeile = Application.Match(strSuchtext, .Columns(3), 0) .Range(.Cells(1, lngFindspalte), .Cells(4, .Columns.Count - lngFindspalte)).Delete Shift:=xlToLeft .Range(.Cells(lngFindzeile, 4), .Cells(lngFindzeile + 3, .Columns.Count - lngFindspalte)).Copy .Cells(1, lngFindspalte) End With End Sub

Sub t() Dim strSuchtext As String Dim lngFindzeile As Long, lngFindspalte As Long With Worksheets("Tabelle1") strSuchtext = .Range("A1") lngFindspalte = Application.Match(strSuchtext, .Rows(1).EntireRow.Resize(1, .Columns.Count - 1).Offset(0, 1), 0) + 2 lngFindzeile = Application.Match(strSuchtext, .Columns(3), 0) .Range(.Cells(1, lngFindspalte), .Cells(4, .Columns.Count - lngFindspalte)).Delete Shift:=xlToLeft .Range(.Cells(lngFindzeile, 4), .Cells(lngFindzeile + 3, .Columns.Count - lngFindspalte)).Copy .Cells(1, lngFindspalte) End With End Sub

Beliebteste Forumthreads (12 Monate)

dynamisches Löschen und Kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread