Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 18:41:19
vba Zeilen duplizieren ab aktiver Zeile bis letzte Zeile
25.04.2024 18:22:55
Zeilen mit bestimmtem Datum in andere Mappe übertragen
25.04.2024 18:14:45
VBA - Excell - Kopie und "Diebstahl" Schützen
25.04.2024 17:49:39
Bedingte Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1868to1872
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1868to1872
1868to1872
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren zwischen zwei Wörtern

Kopieren zwischen zwei Wörtern
16.02.2022 11:45:08
Micha
Hallo zusammen,
ich habe eine UF welche mir mehrere Spalten aus verschiedenen Tabellenblätter in Tabellenblatt1 (Übersicht) untereinander zusammenführt.
Dieses klappt auch wirklich so wie ich es benötige. Das Anfang und das Ende kann ich über eine Inputbox eingeben. Die Leerzeilen werden super ausgelassen.
Das Problem ist, dass das Anfang und das Ende auf den Blättern variieren kann.
Meine Idee ist das Automatisch immer nach dem Wort " Anfang" und "Ende" gesucht wird und die Spalte dazwischen zur Übersicht übertragen werden.
https://www.herber.de/bbs/user/151161.xlsm
Leider bekomme ich es nach 2 Tagen nicht hin die Range über die Wörter zu definieren.
Vielleicht kann wer helfen.

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren zwischen zwei Wörtern
16.02.2022 13:04:52
AlterDresdner
hallo Micha,
die Zeile eines Begriffes könnte man finden (z.B. in Sub Suchen) mit
Const SucheAnfang = "Anfang"
Set erg = Blatt.Range("B:B").Find(What:=SucheAnfang, lookat:=xlWhole)
If erg Is Nothing Then
MsgBox "Begriff " & SucheAnfang & " nicht gefunden"
Exit Sub
End If
iRow = erg.Row
Gruß der ALteDresdner
AW: Kopieren zwischen zwei Wörtern
16.02.2022 13:18:40
Micha
Hallo AlteDresdner,
vielen Dank für deine schnelle Antwort, ganz hab ich es leider nicht hinbekommen, auch mit der Suche und der Übergebe.
Bekomme immer eine Fehlermeldung.
Gruß Micha
AW: Kopieren zwischen zwei Wörtern
16.02.2022 13:41:25
EtoPHG
Hallo Micha,
...und die (Fehlermeldungen) willst Du, wie deinen Code, natürlich für Dich behalten? Aus Datenschutzgründen, oder wie oder was oder warum?
Gruess Hansueli
Anzeige
AW: Kopieren zwischen zwei Wörtern
16.02.2022 14:00:05
Micha
Hallo Hansueli,
ich bekomm es einfach nicht hin die inputbox durch das Suchen des Wertes Anfang und Ende zu ersetzen.
Der Code ist in der Bespieldatei doch zu sehen?
Sorry.
AW: Kopieren zwischen zwei Wörtern
16.02.2022 14:50:59
AlterDresdner
Hallo Micha,
das 

Sub Suchen würde bei mir so aussehen:


Sub suchenneu()
Dim iRow As Long, iRowEnd As Long
Const SucheEnde = "Ende"
Const SucheAnfang = "Anfang"
Dim Blatt As Worksheet, erg As Variant
Set Blatt = Sheets("Tabelle2") '!!!!!
Set erg = Blatt.Range("B:B").Find(What:=SucheAnfang, LookIn:=xlValues, lookat:=xlWhole, after:=Blatt.Range("B1"))
If erg Is Nothing Then
MsgBox "Begriff " & SucheAnfang & " nicht gefunden"
Exit Sub
End If
iRow = erg.Row
Set erg = Blatt.Range("B:B").Find(What:=SucheEnde, LookIn:=xlValues, lookat:=xlWhole, after:=Blatt.Range("B1"))
If erg Is Nothing Then
MsgBox "Begriff " & SucheEnde & " nicht gefunden"
Exit Sub
End If
iRowEnd = erg.Row
End Sub


Außerdem solltest Du das Leerzeichen am Ende von "Anfang" in der Datei entfernen oder gleich nach "Anfang " suchen.

Wenn Du immer noch einen Fehler hast, poste den verwendeten Code und den Fehler, das würde das Raten ersparen...

Gruß der ALteDresdner
Anzeige
AW: Sorry, aber....
16.02.2022 15:14:50
EtoPHG
ich hab die Beispielmappe erst jetzt angeschaut.
Ich kann mir überhaupt nicht vorstellen was genau du mit "Anfang" und "Ende" meinst.
Im Grunde genommen ist mir das ganze Konstrukt völlig schleierhaft.
Ich sehe auch nirgends Fehlermeldungen, ausser ich provoziere welche, indem ich in einer Inputbox, die einer Long-Variablen zugeordnet wird, einen Text eingebe. Eine Inputbox liefere immer TEXT (string) zurück.
Vielleicht erläuterst du nochmals deine Anforderung und Ziel und einer Beschreibung der Arbeitsschritte für den Anwender der Userform.
Gruess Hansueli
AW: Sorry, aber....
16.02.2022 15:31:48
Micha
Hallo Hansueli,
die Fehlermeldung habe ich bekommen, wenn ich versucht habe den Code von "AlteDresdner" anstelle der Inputbox für "Anfang" und "Ende" zu übernehmen.
Die Beispieldatei so funktioniert einwandfrei und wie schon geschrieben, variieren die Bereiche die Kopiert werden in den Tabellenblättern.
Ziel ist es hier, durch das finden der Wörter "Anfang" und "Ende" in den Tabellenblättern welche über die UF markiert werden (in der Originaldatei sind es natürlich andere Wörter) den Bereich zu definieren und so nicht jedes Tabellenblatt in der Listbox einzeln zu kontrollieren bzw. den Bereich festzulegen und das zu kopierende Anfang und Ende einzugeben.
So könnten die Inputboxes ersetzt werden und es würde Automatisch zwischen den zwei Wörter die Bereiche auf Tabellenblatt Übersicht, ohne Leerzeilen kopiert.
Hoffe DU kannst mir Folgen...
Danke für deine Geduld und hilfe
Anzeige
AW: Sorry, aber....
16.02.2022 18:27:02
AlterDresdner
Hallo Micha,
ersetze mal etwas Code:
einmal in CommandButton3_Click:
Set wksZiel = Worksheets("Übersicht")
Application.ScreenUpdating = False
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
If ListBox1.List(i) "Alles" Then
Set wksStart = Worksheets(ListBox1.List(i))
With wksStart
On Error Resume Next
RangeAnfang = .Range("B:B").Find(What:="Anfang ", LookIn:=xlValues, lookat:=xlWhole, after:=wksStart.Range("B1")).Row
RangeEnde = .Range("B:B").Find(What:="Ende", LookIn:=xlValues, lookat:=xlWhole, after:=wksStart.Range("B1")).Row
If Err Then
MsgBox "Im Blatt " & ListBox1.List(i) & " wurde einer der Suchbegriffe Anfang, Ende nicht gefunden"
Exit Sub
End If
For cnt = RangeAnfang To RangeEnde
If cnt = RangeAnfang Then wksZiel.Range("B" & wksZiel.Cells(Rows.Count, "C").End(xlUp).Row + 1).Value = .Range("B6").Value
wksZiel.Range("C" & wksZiel.Cells(Rows.Count, "C").End(xlUp).Row + 1).Value = .Cells(cnt, "B").Value
wksZiel.Range("D" & wksZiel.Cells(Rows.Count, "D").End(xlUp).Row + 1).Value = .Cells(cnt, "C").Value
wksZiel.Range("E" & wksZiel.Cells(Rows.Count, "E").End(xlUp).Row + 1).Value = .Cells(cnt, "E").Value
wksZiel.Range("F" & wksZiel.Cells(Rows.Count, "F").End(xlUp).Row + 1).Value = .Cells(cnt, "G").Value
'wksZiel.Range("F" & wksZiel.Cells(Rows.Count, "C").End(xlUp).Row + 1).Value = wksStart.Cells(cnt, "Y").Value
Next
End With
End If
End If
Next
und außerdem in Löschen:
Tabelle1.Range("B2:F1000").ClearContents
Die 1000 solltest Du eigentlich selbst mit dem Konstrukt End(xlUp).Row richtig setzen können.
Es wird immer noch nach "Anfang " mit Leerzeichen gesucht, außerdem fehlt in Tabelle5 das Ende.
Ohne Dir zu nahe treten zu wollen: Bist Du sicher, dass diese Aufgabe das Richtige für Dich ist?
Gruß der AlteDresdner
Anzeige
AW: Sorry, aber....
16.02.2022 22:55:44
Martin
Hallo AlteDresdner,
erst einmal vielen lieben Dank, dass ist genau das was ich gesucht habe und alles klappt wunderbar!!!! Herzlichen Dank!
Ich hätte nicht gedacht das es dann doch etwas zu viel ist und doch so schwierig. Das war bei mir wohl der Optimismus der Unwissenheit, aber ich schau mir alles genau an damit ich es Nachvollziehen kann und natürlich draus lernen kann.
Nochmals vielen Dank und eine gute Nacht!

Links zu Excel-Dialogen

UserForm InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige