Suche nach Tabelle, laut Zellenname und ....

Sub LNW_01_erstellen() ' LNW_01_erstellen Makro ' erstellt 01. LNW der Liste Projekte ' Erstellt ein neues Arbeitsblatt mit dem Namen des Zelleninhaltes "B6" Sheets("Tab Blanko").Copy Before:=Sheets(3) Range("B6").Select ActiveCell.FormulaR1C1 = "='Liste Projekte'!R[2]C" On Error GoTo FEHLER ActiveWorkbook.ActiveSheet.Name = Range("B6").Text Exit Sub FEHLER: MsgBox "Leistungsnachweis bereits vorhanden", vbCritical, "Tabelle umbenennen" Dim rngSpalte As Range With ActiveSheet.UsedRange .Replace 0, True, xlWhole For Each rngSpalte In .Columns On Error Resume Next rngSpalte.SpecialCells(xlCellTypeConstants, 4).Delete shift:=xlShiftUp On Error GoTo 0 Next End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim ws As Worksheet With Worksheets("Liste Projekte") .Range("F8").Interior.Color = xlNone For Each ws In ThisWorkbook.Worksheets If ws.Name = .Range("B8") Then .Range("F8").Interior.Color = 5287936 Exit For End If Next ws End With End Sub

Hallo Chris!
habe deinen Code in den bestehenden Makro eingetragen, aber es regte sich leider gar nichts.
Wenn ich ihn in das dafür vorgesehene Arbeitsblatt "Liste Projekte"(siehe Bild) unter MS Excel Objekte eintrage,stellt sich die Farbe dauerhaft ein, obwohl noch gar kein Blatt mit dem Titel der Projektnummer existiert.
Userbild

Ich hatte auch vergessen zu erwähnen, dass dieser Ausdruck für die Zeilen 8 - 25 angewendet werden soll
Zum ausprobieren, hier die angepasste Datei,
mit bereits vorgefertigten Arbeitsblättern mit Projektnummer als Blattnamen.
Das Makro soll auf Tabelle "Liste Projekte" angewendet werden.
https://www.herber.de/bbs/user/126487.xlsx
Man könnte auch alternativ folgendes sagen:
Vergleiche den Bereich "Liste Projekte!B8:B25" mit der Zelle "B6" aller Arbeitsblätter.
Wenn Treffer Markiere in "Liste Projekte" den Treffer in entsprechender Zeile von A bis E oder nur die Zeile in Spalte F in grün
Geht das evtl. einfacher?
Gruß
Holger

Sub t() Dim ws As Worksheet With Worksheets("Liste Projekte") .Range("F8:F25").Interior.Color = xlNone On Error Resume Next For Each ws In ThisWorkbook.Worksheets .Cells(Application.Match(ws.Range("B6"), .Columns(2), 0), 6).Interior.Color = 5287936 Next ws On Error GoTo 0 End With End Sub

Sub t() Dim ws As Worksheet With Worksheets("Liste Projekte") .Range("F8:F25").Interior.Color = xlNone On Error Resume Next For Each ws In ThisWorkbook.Worksheets If IsNumeric(ws.Range("B6")) Then _ .Cells(Application.Match(ws.Range("B6"), .Columns(2), 0), 6).Interior.Color = 5287936 Next ws On Error GoTo 0 End With End Sub

Ich musste es allerdings doch etwas abwandeln, weil beim Tabelle löschen alle Färbungen verschwanden.
Darum habe ich deinen Code erneut kopiert und umgewandelt in "Keine Füllung"
in Modul


Sub t()
Dim ws As Worksheet
With Worksheets("Liste Projekte")
.Range("F8:F25").Interior.Color = xlNone
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
If IsNumeric(ws.Range("B6")) Then _
.Cells(Application.Match(ws.Range("B6"), .Columns(2), 0), 6).Interior.Color = 5287936
Next ws
On Error GoTo 0
End With
End Sub
Sub s()
'existiert Tabelle laut namen "B6" wir "Liste Projekte"Spalte F weiß
Dim ws As Worksheet
With Worksheets("Liste Projekte")
.Range("F8:F25").Interior.Color = xlNone
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
If IsNumeric(ws.Range("B6")) Then _
.Cells(Application.Match(ws.Range("B6"), .Columns(2), 0), 6).Interior.Color = xlNone
Next ws
On Error GoTo 0
End With
End Sub

und in Tabelle

Private Sub Worksheet_Change1(ByVal Target As Range)
If Target.Column = 2 Then Call t
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then Call s
End Sub

Call t wie du sagtest tritt beim erstellen des Blattes in Krafft
Call s also beim löschen
Und den Löschmakro sieht dann so aus

Sub Lösche_Arbeitsblatt()
Call s
ActiveSheet.Select
ActiveWindow.SelectedSheets.Delete
Call t
End Sub

Wieder was gelernt! Dank dir!
Gruß
Holger

Beliebteste Forumthreads (12 Monate)

Suche nach Tabelle, laut Zellenname und ....

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread