5 Personen Prüfen ein paar Dinge von Mitarbeitern. Dafür benutzen sie alle eine Exceltabelle. Sagen wir mal, das Unternehmen hat 20 Mitarbeiter, jeder PRÜFER schreibt dann z.B: in Spalte alle Daten von Müller. In Spalte B alle Daten von Meier. In Spalte C alle Daten von Schmitz usw.
Das macht jeder von den 5 Prüfern. Alle haben das selbe Formular.
Nun soll folgendes ermöglicht werden.
Von ALLEN 5 Prüfern sollen alle Daten von Müller (Spalte A) in ein externes Tabellenblatt importiert werden, so dass man nur noch einen Ausdruck für Müller braucht und alle Daten, von allen 5 Prüfern werden dort aufgelistet.
Das muss dann natürlich für jeden Mitarbeiter ermöglicht werden…
habt ihr verstanden wie ich es meine??? Ich hoffe ja… Wie kann ich das am besten erstellen? Habe leider nur Grundkenntnisse in Excel ;(
eine Lösung nur mit Formel (also ohen VBA) wird nicht einfach sein, da Du nicht erwähnt hast, ob die Regel existiert, wieviele Daten ein Prüfer über einen Prüfling eintragen darf.
Dass Ganze würde auch nur funktionieren, wenn die Daten mit festen Namen an einer festen Stelle stehen. [Okay: es geht auch mit variablen Namen, aber dann müsste man eines erklären …]
Von ALLEN 5 Prüfern sollen alle Daten von Müller (Spalte A) in
ein externes Tabellenblatt importiert werden, so dass man nur
noch einen Ausdruck für Müller braucht und alle Daten, von
allen 5 Prüfern werden dort aufgelistet.
Das muss dann natürlich für jeden Mitarbeiter ermöglicht
werden…
Hallo Kolri,
Vorsicht, Code löscht in der Mappe in der er steht den Inhalt von Tabelle1 um Tabelle1 dann neu zu beschreiben.
Alt+F11, Einfügen—Modul, Code reinkopieren, Anpassen, Editor schliessen.
Makro starten mit Alt+F8…
Sub Liste()
Dim wks As Worksheet, Zei As Long, Blaetter, B As Integer
Set wks = ThisWorkbook.Worksheets("Tabelle1") 'anpassen
Const Pfad As String = "c:\test\" 'anpassen
Blaetter = Array("Pruef1", "Pruef2", "Pruef3", "Pruef4", "Pruef5") 'anpassen
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Tabelle1") 'anpassen
.UsedRange.Clear
For B = LBound(Blaetter) To UBound(Blaetter)
Workbooks.Open Pfad & Blaetter(B) & ".xls"
Zei = .Cells.SpecialCells(xlLastCell).Row
ActiveWorkbook.Worksheets("Tabelle1").UsedRange.Copy \_
Destination:=.Cells(IIf(Zei = 1, 1, Zei + 1), 1).End(xlUp).Row
ActiveWorkbook.Close savechanges:=False
Next B
End With
Application.ScreenUpdating = True
End Sub