Übergreifendes Makro in Tabelle

[Stefan87]

Hallo zusammen

Ich bin am verzweifeln seit einigen Stunden. Habe einen Code aus dem Internet genommen, und habe ihn ein wenig angepasst aber er funktioniert nicht so wie gedacht. Vielleicht kann mir einer sagen was ich falsch mache.
Ich möchte eine Schaltfläche auf der Tabelle 1, der mir dann auf der Tabelle 3 die Aktion ausführt, aber schaffe es nicht. Wenn ich die Schaltfläche auf der Tabelle 3 einbinde, funktioniert dies.

Anbei der Code welcher angepasst ist:

Code:

Option Explicit
Const Titel = "Nicht benötigte Artikel"
Const Msg = "Welche BMK werden nicht benötigt?"
   
Sub Artikel_entfernen_Partlist()
    Dim i As Long           ' Zeilenzähler
    Dim tofind As Variant   ' Hiernach wird gesucht
    Dim found As Range      ' Eine Fundstelle oder Nothing
    tofind = InputBox(prompt:=Msg, Title:=Titel)
    If tofind = "" Then Exit Sub
    Application.ScreenUpdating = False
    For i = ThisWorkbook.Worksheets("Partlist").Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1
        Set found = Rows(i).Find(what:=tofind, _
        LookIn:=xlValues, lookat:=xlWhole)
            If Not found Is Nothing Then Rows(i).Delete
    Next
    Application.ScreenUpdating = True
End Sub

Mit dem Code, möchte ich über die Input Box sagen, wenn in einer Zeile dieser Text steht, das er die ganze Zeile löscht und 1 nach oben schiebt.

[{Boris}]

Hi,

Du musst - in Deinem konkreten Fall - vor jedem

Rows(i)

den Blattnamen mit referenzieren:

Worksheets("Tabelle3").Rows(i)

da ansonsten auf das Blatt referenziert wird, das beim Aufruf aktiv ist.

[Stefan87]

Du meinst, das es so aussehen müsste?

Code:

Sub Artikel_entfernen_Partlist()
    Dim i As Long           ' Zeilenzähler
    Dim tofind As Variant   ' Hiernach wird gesucht
    Dim found As Range      ' Eine Fundstelle oder Nothing
    tofind = InputBox(prompt:=Msg, Title:=Titel)
    If tofind = "" Then Exit Sub
    Application.ScreenUpdating = False
    For i = Worksheets("Tabelle3").Rows(i).Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1
        Set found = Rows(i).Find(what:=tofind, _
        LookIn:=xlValues, lookat:=xlWhole)
            If Not found Is Nothing Then Rows(i).Delete
    Next
    Application.ScreenUpdating = True
End Sub

Funktioniert leider nicht

[{Boris}]

Hi,

nein, Du musst meine Antwort auch komplett lesen:

Du musst - in Deinem konkreten Fall - vor jedem

Rows(i)

den Blattnamen mit referenzieren:

Rows(i) gibt es noch ein 2. mal.

[Stefan87]

Bekomme dann diesen Fehler



mit folgendem angepassten Code:

Code:

Sub Artikel_entfernen_Partlist()
    Dim i As Long           ' Zeilenzähler
    Dim tofind As Variant   ' Hiernach wird gesucht
    Dim found As Range      ' Eine Fundstelle oder Nothing
    tofind = InputBox(prompt:=Msg, Title:=Titel)
    If tofind = "" Then Exit Sub
    Application.ScreenUpdating = False
    For i = Worksheets("Tabelle3").Rows(i).Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1
        Set found = Rows(i).Find(what:=tofind, _
        LookIn:=xlValues, lookat:=xlWhole)
            If Not found Is Nothing Then Worksheets("Tabelle3").Rows(i).Delete
    Next
    Application.ScreenUpdating = True
End Sub

[{Boris}]

Hi,

nochmal: Vor jedem.

Da hab ich mich auf die Schnelle verzählt - es sind 3.

[Stefan87]

Hi,

nochmal: Vor jedem.

Da hab ich mich auf die Schnelle verzählt - es sind 3.

Auch dann funktioniert es nicht. Jetzt ist vor jedem Rows (i) das Worksheet definiert.

Code:

Sub Artikel_entfernen_Partlist()
    Dim i As Long           ' Zeilenzähler
    Dim tofind As Variant   ' Hiernach wird gesucht
    Dim found As Range      ' Eine Fundstelle oder Nothing
    tofind = InputBox(prompt:=Msg, Title:=Titel)
    If tofind = "" Then Exit Sub
    Application.ScreenUpdating = False
    For i = Worksheets("Tabelle3").Rows(i).Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1
        Set found = Worksheets("Tabelle3").Rows(i).Find(what:=tofind, _
        LookIn:=xlValues, lookat:=xlWhole)
            If Not found Is Nothing Then Worksheets("Tabelle3").Rows(i).Delete
    Next
    Application.ScreenUpdating = True
End Sub

[{Boris}]

Hi,

dann lautet der Blattname nicht Tabelle3 sondern Tabelle 3 (also mit Leerzeichen) oder Tabelle sonstwas...?
Das musst Du natürlich auf Deine Gegebenheiten anpassen.

[Stefan87]

Hi,

dann lautet der Blattname nicht Tabelle3 sondern Tabelle 3 (also mit Leerzeichen) oder Tabelle sonstwas...?
Das musst Du natürlich auf Deine Gegebenheiten anpassen.

Bei mir sind die Tabelle so geschrieben wie auf dem Bild. Auch wenn ich den Namen der Tabelle ( Partlist ) eintrage, funktioniert es nicht und meldet einen Fehler.

[{Boris}]

Hi,

dann musst Du 3 mal Worksheets("Partlist") voranstellen - oder aber mal Deine Mappe hier hochladen, denn weitere Ideen habe ich ohne eben diese nicht.