Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeile in allen Tabellenblättern durchsuchen

Zeile in allen Tabellenblättern durchsuchen
14.03.2009 13:26:44
ben
Hallo,
bei folgendem Problem stoße ich mit meinen Excel/VBA Kenntnissen an die Grenze.
Ich würde gern, wenn die Zelle C57 im Blatt Menü ein Wochentag ist, eine Suche in allen Tabellenblättern in der Zeile 9 nach dem Wert der in Zelle C58 (ist die Kalenderwoche) im Blatt Menü steht starten. Wenn der Wert gefunden wurde soll die Spalte markiert, kopiert und daneben eingefügt werden. Der gefundene Begriff soll dann in der alten Spalte mit einem a und in der neu eingefügten mit einem b erweitert werden.
Ich habe es bis jetzt in VBA so versucht:

Sub ButtonKalender()
t1 = ThisWorkbook.Worksheets("Menü").Range("C57")
If t1 = "Montag" Or t1 = "Dienstag" Or t1 = "Mittwoch" Or t1 = "Donnerstag" Or t1 = "Freitag"   _
_
Then
w1 = ThisWorkbook.Worksheets("Menü").Range("C58")
Dim rngSuche1 As Range
For Each Sheet In ActiveWorkbook.Sheets
For Each rngSuche1 In Worksheets.Range("B9 : BZ9").Find(What:=w1, LookAt:=xlWhole) ' _
kann die row nicht bestimmen, deswegen die range
If Not rngSuche1 Is Nothing Then rngSuche1.EntireColumn.Select
Selection.EntireColumn.Copy
Selection.Insert Shift:=xlToRight
Set rngSuche1 = ActiveSheet.Range("B9 : BZ9").Find(What: _
_
=w1, LookAt:=xlWhole)
If Not rngSuche1 Is Nothing Then rngSuche1.Select
ActiveCell.Value = w1 & " a"
Set rngSuche1 = ActiveSheet.Range("B9 : BZ9").Find(What: _
_
=w1, LookAt:=xlWhole)
If Not rngSuche1 Is Nothing Then rngSuche1.Select
ActiveCell.Value = w1 & " b"
ThisWorkbook.Worksheets("Menü").Select
Next rngSuche1
Next Sheet
Else
End If
End Sub


Bin dankbar für jede Hilfe!!!

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeile in allen Tabellenblättern durchsuchen
16.03.2009 12:03:49
fcs
Halo ben,
mit folgenden Anpassungen sollte es funktionieren, dass die Blätter korrekt durchsucht und geändert werden.
Gruß
Franz

Sub ButtonKalender()
Dim sheet As Worksheet
Dim t1 As String, w1 As Variant
Dim rngSuche1 As Range
t1 = ThisWorkbook.Worksheets("Menü").Range("C57")
If t1 = "Montag" Or t1 = "Dienstag" Or t1 = "Mittwoch" Or t1 = "Donnerstag" _
Or t1 = "Freitag" Then
w1 = ThisWorkbook.Worksheets("Menü").Range("C58")
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Name  "Menü" Then
With sheet
Set rngSuche1 = .Range(.Cells(9, 2), .Cells(9, .Columns.Count).End(xlToLeft)) _
.Find(What:=w1, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngSuche1 Is Nothing Then
Do
With rngSuche1.EntireColumn.EntireColumn
.Copy
.Insert Shift:=xlToRight
Application.CutCopyMode = False
End With
rngSuche1.Offset(0, -1).NumberFormat = "@" 'Erforderlich, wenn KW nur als Zahl _
vorhanden, da Excel Zahlen kleiner 24 sonst in Uhrzeiten wandelt.
rngSuche1.Offset(0, -1).Value = w1 & " a"
rngSuche1.NumberFormat = "@"
rngSuche1 = w1 & " b"
Set rngSuche1 = .Range(.Cells(9, 2), .Cells(9, .Columns.Count).End(xlToLeft)) _
.Find(What:=w1, LookIn:=xlValues, LookAt:=xlWhole)
Loop Until rngSuche1 Is Nothing
Else
'MsgBox "In Blatt """ & .Name & """ den Wert """ & w1 & """ nicht gefunden!"
End If
End With
End If
Next sheet
Else
End If
End Sub


Anzeige

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige