Tabelle nach Mitarbeiter teilen und neue Dateien erzeugen

[Philly]

Hallo Zusammen,

ich habe eine Tabelle in der Equipments gelistet sind. Jede Zeile ist eine Maschine.
In Spalte A steht der verantwortliche Außendienstmitarbeiter für Produktsparte ETI.
In Spalte B steht der verantwortliche Außendienstmitarbeiter für Produktsparte COD.

Ich möchte aus der Gesamtliste für jeden Mitarbeiter eine einzelne Datei mit seinen Maschinen im Markt erzeugen. Diese soll wie folgt heißen IB_Personalnummer (bspw. "IB_800" "IB_801" etc.)

Bsp.: Eine Datei soll erzeugt werden wo alle Maschinen für den Mitarbeiter Nr. 800 stehen und so weiter.
Anschließend für die Produktsparte COD, wo die Mitarbeiter Nr. in Spalte B stehen.

Ich habe es mit Makros probiert, aber meine Kenntnisse sind nicht gut genug leider.
die Datei wird jeden Monat erstellt und der manuelle Aufwand das für zich Mitarbeiter zu machen steht in keinem Verhältnis.

Ich wäre für eure Hilfe super Dankbar. Ich weiß das es sich mit Makros lösen lassen kann, ich habe auch einiges gelesen aber hinbekommen tue ich es nicht.

Beste Grüße
Phil

[Ralf A]

Hi,

und was machst Du dann mit den Dateien? Anschauen? Ausdrucken? Das kannst Du auch, wenn Du einen stinknormalen Filter oder Datenschnitt verwendest, statt unnötig viele Dateien zu generieren....

[Philly]

Hallo Ralf,

die werden dem Mitarbeiter zur Verfügung gestellt und per Mail an ihn versandt.
Der Mitarbeiter soll auch nur Zugriff auf seine eigenen Maschinen haben.

Gruß
Phil

[HKindler]

Hi,

wenn du in Y2 deine Mitarbeiter-Nr schreibst, bekommst du bei aktuellem Excel mit
=FILTER(Tabelle1;(Tabelle1[VB-ETI]=$Y$2)+(Tabelle1[VB-IJ]=$Y$2)+(Tabelle1[VB-LAS]=Y2))
alle Zeilen in denen in A, B oder C dieser Mitarbeiter auftaucht.

Wenn du kein aktuelles Excel hast, verwendest du entweder das CSE-Addin von Flotter Feger oder Excel-Online.

[Case]

Moin,  

per VBA hier eine Möglichkeit (getestet in deiner Beispieldatei):

Code:

Option Explicit
Public Sub Main()
    Dim wksSheet As Worksheet
    Dim strTMP As String
    Const lngColumn As Long = 1
    On Error GoTo Fin
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wksSheet = Worksheets.Add(After:=Tabelle1)
    With wksSheet
        Tabelle1.UsedRange.Copy .Cells(1, 1)
        .UsedRange.Sort Key1:=.Cells(1, lngColumn), Order1:=xlAscending, Header:=xlYes
        Do
            strTMP = .Cells(2, lngColumn).Value
            If strTMP = "" Then Exit Do
            .UsedRange.AutoFilter Field:=lngColumn, Criteria1:=strTMP
            With Workbooks.Add
                wksSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy .Sheets(1).Cells(1, 1)
                .SaveAs "C:\Temp\" & strTMP & "_" & Format(Now, "yyyy_mm_dd"), 51
                .Close
            End With
            .UsedRange.Offset(1, 0).EntireRow.Delete
        Loop
        wksSheet.Delete
    End With
Fin:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & " " & Err.Description
End Sub 

Speicherpfad noch anpassen.

[Ralf A]

die werden dem Mitarbeiter zur Verfügung gestellt und per Mail an ihn versandt.
Der Mitarbeiter soll auch nur Zugriff auf seine eigenen Maschinen haben.

...,auch dazu muss man nicht 100te Dateien erstellen. Die Daten entsprechend Filtern und via HTML Mail den gefilterten Bereich per eMail verschicken. Das wäre zumindest meine favorisierte Option. Ansonsten kannst Du selbstverständlich alles machen, was auch immer Dir am Liebsten ist...

Ich vermute mal, Dein Problem ist ja nicht das Erstellen der Datei oder der Mail, sondern die Auswahl aller notwendigen Filter. Wie das geht, kann ich Dir ja schnell mal zeigen. Den Rest musst Du Dir selbst machen.
Hinweis, die formartierte Tabelle hab ich umbenannt in tblRohdaten und ich verwende die ersten 3 Spalten. Und es muss sichergestellt sein, dass Spalte L keine Daten enthält. Das alles muss bei Dir evtl. angepasst werden.

 

Code:

Sub Start()

Dim Spalte As Integer, Zeile As Long
Application.ScreenUpdating = False
Tabelle1.Activate
For Spalte = 1 To 3
    EindeutigeZeilenwerte Spalte
    Zeile = 2
        Do Until Cells(Zeile, 12) = ""
'            Debug.Print Cells(Zeile, 12).Value
            Range("tblRohdaten").AutoFilter Spalte, Cells(Zeile, 12)
            '********************************************************
                '...und hier dazwischen machst Du alles, was zum Speichern oder Mail versenden oder was auch immer erforderlich ist...
            '********************************************************
            Range("tblRohdaten").AutoFilter
            Zeile = Zeile + 1
        Loop
    Columns(12).ClearContents
Next Spalte
Application.ScreenUpdating = True

End Sub

Sub EindeutigeZeilenwerte(ausSpalte As Integer)
   Dim adr As Range, n As String
    Set adr = Cells(1, ausSpalte)
    n = "tblRohdaten[" & adr & "]"
    Tabelle1.Range("L2").Formula2R1C1 = "=UNIQUE(" & n & ",FALSE,FALSE)"
End Sub