In Tabellen suchen und Resultat kopieren

Guten Morgen

Ich habe folgendes Problem:
Ein Makro wäre sehr gut.
Ich habe 30 bzw. 31 Tabellenblätter in einer Mappe.
Hier trägt nun die Sekretärin ein ob das Personal anwesend ist oder nicht.
z.B. Tabelle 1 heisst "01.01.2003" und in jeder Tabelle stehen die 20 Mitarbeiter d.h. alle Tabellen sind gleich nur der Namen des Blattes wechselt.
Die Sekretärin trägt nun ein Mitarbeiter Charlie "Nein".

Ich möchte nun nicht jedesmal die 30 b.z.w.31 Tablellenblätter durchsuchen müssen um zu sehen wer anwesend war oder nicht.
Ich Möchte nun dass Excel wenn in der Reihe "D" ( es ist immer "D") eines Tabellenblattes "nein" steht mir die ganze Reihe wo das Nein steht -z.B. Reihe 3 so dass ich den Namen und das "nein" - untereinander in ein neues Tabellenblatt kopieren z.B. "Nichtanwesend".??
Ich hoff das war nicht zu langweilig

Gruss lucien und danke im voraus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lucien für in deine Tabelle ein weiteres Tabellenblatt ein und benenne es um
nach "Übersicht"
dann das Makro laufen lassen und es werden alle Datensätze mit nein übertragen!
Gruß
Willie
Falls es probleme gibt ... einfach nochmal melden!

Public


Sub suchen()
ThisWorkbook.Activate
Dim Zelle As Range, Suchbegriff As String, Adresse As String, zaehler As Integer
Dim index As Integer, Feld() As String, Tabelle() As Integer, Zeile_Spalte() As String
Dim Suche As Variant
i = 3
Suchbegriff = "nein" 'InputBox("Suchbegriff eingeben", "Eingabe")
If Suchbegriff <> "" Then
For index = 1 To Worksheets.Count
With Sheets(index).Cells
Set Zelle = .Find(What:=Trim(Suchbegriff), LookAt:=xlPart)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
zaehler = zaehler + 1
ReDim Preserve Feld(1 To zaehler)
ReDim Preserve Tabelle(1 To zaehler)
ReDim Preserve Zeile_Spalte(1 To zaehler)
Feld(zaehler) = Sheets(index).Name & " Spalte " & Zelle.Column & " Zeile " & Zelle.Row
Tabelle(zaehler) = index
Zeile_Spalte(zaehler) = Zelle.Address
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
End With
Next
If zaehler > 0 Then
If MsgBox(Suchbegriff & " wurde " & CStr(zaehler) & " mal gefunden." & vbNewLine & "Fundstellen übertragen?", 68, "Information") = 7 Then Exit Sub
Do
For index = 1 To zaehler
Sheets(Tabelle(index)).Select
Range(Zeile_Spalte(index)).Select
ActiveWindow.ScrollColumn = Selection.Column
ActiveWindow.ScrollRow = Selection.Row
Suche = ActiveWindow.ScrollRow
If Suche > 2 Then
Range("A" & Suche & ":CM" & Suche).Select
Selection.Copy
Blattname = ActiveSheet.Name
Sheets("Übersicht").Activate
Cells(i, 1).Select
i = i + 1
ActiveSheet.Paste
Else
GoTo weiter
End If
weiter:
If zaehler = 1 Then Exit Sub
If index < zaehler Then
'If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Weitere anzeigen?", 68, "Information") = 7 Then Exit Sub
Else
If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Nochmal übertragen?", 68, "Information") = 7 Then Exit Do
End If
Next
Loop
Else
MsgBox Suchbegriff & " wurde nicht gefunden", 64, "Information"
End If
End If
ThisWorkbook.Activate
End Sub

Beliebteste Forumthreads (12 Monate)

In Tabellen suchen und Resultat kopieren

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

In Tabellen suchen und Resultat kopieren

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

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread