Auslesen von Mitarbeitern und Kopieren in neue Tab

Forumthread: Auslesen von Mitarbeitern und Kopieren in neue Tab

18.05.2007 15:17:30

Mitarbeitern

Hallo lieber Excelaner,
ich habe folgendes Problem. In einer Arbeitsmappe sind mehrere Arbeitsblätter mit Mitarbeitern aus unterschiedlichen Bereichen. Ich habe jetzt jedem Mitarbeiter drei Kontrollkästchen zugeordnet. Wenn eins dieser Kontrollkästchen auf WAHR steht möchte ich diesen Mitarbeiter in eine neue Tabelle kopiert bekommen. In der neuen Tabelle sollen die Mitarbeiter untereinander aufgelistet werden.Das Problem besteht darin, dass es ca. 20 Tabellenblätter mit insgesamt ca. 260 Mitarbeiter sind. Sonst könnte ich mit der Wenn Funktion arbeiten.
Über Hilfe würde ich mich sehr freuen.
Gruß
Michael

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Auslesen von Mitarbeitern und Kopieren in neue

19.05.2007 01:51:00

Mitarbeitern

AW: Auslesen von Mitarbeitern und Kopieren in neue

19.05.2007 01:51:00

Mitarbeitern

Hallo Michael,
wenn das WAHR dann auch jeweils in einer Zelle steht, dann geht es mit folgendem Makro. Tabellennamen, Spaltennummern und Startzeilennummern muss du natürlich noch anpassen.
Gruß
Franz


Sub NamenAuslesen()
Dim wksListe As Worksheet, wksMitarbeiter As Worksheet
Dim ZeileListe  As Long, ´Reihe As Long
Set wksListe = Worksheets("Liste") 'Tabelle in die Mitarbeiter kopiert werden sollen
ZeileListe = 2  'Zeile ab der Mitarbeiter eingetragen werdne sollen
'Alte Daten in Liste löschen
With wksListe
.Range(.Rows(ZeileListe), .Rows(.Cells(.Rows.Count, 1).End(xlUp).Row)).ClearContents
End With
For Each wksMitarbeiter In ActiveWorkbook.Worksheets
Select Case wksMitarbeiter.Name
Case "Liste", "Tabelle3" 'Liste der Tabellennamne, die keine Mitarbeiter enthalten
'do nothing
Case Else
With wksMitarbeiter
'2 in nächter Zeile ist die Reihe ab der in Mitarbeiter-tabellen ausgelesen werden soll
For Reihe = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Überprüfung der Spalten 4, 5 und 6 auf WAHR (False)
If .Cells(Reihe, 4).Value = True Or .Cells(Reihe, 5).Value = True _
Or .Cells(Reihe, 6).Value = True Then
wksListe.Cells(ZeileListe, 1).Value = .Cells(Reihe, 1) 'Name
wksListe.Cells(ZeileListe, 2).Value = .Cells(Reihe, 2) 'Vorname
ZeileListe = ZeileListe + 1
End If
Next
End With
End Select
Next
End Sub

Beliebteste Forumthreads (12 Monate)

Auslesen von Mitarbeitern und Kopieren in neue Tab

Forumthread: Auslesen von Mitarbeitern und Kopieren in neue Tab

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread