Dynmaische Erweiterung If Then Else und Blatterstellung

Guten Morgen,
ich versuche mir gerade VBA beizubringen. Ich versuche hierbei mir mit Kommentierungen alles Schritt für Schritt zu erklären, damit ich den Transfer für weitere Projekte leisten kann.
Mein Aufgabe: Ene Aufgabenliste erstellen. Die Aufgabenliste soll Arbeitszettel für jeden Mitarbeiter erstellen, der in Tabelle 4 Spalte A aufgeführt ist. Die Anzahl der Mitarbeiter ist Dynamisch und wird durch eine Pivotabelle dargestellt. Es wäre wichtig, dass die Aufgaben vor jeder Zuteilung aus den Arbeitszetteln gelöscht werden, damit keine doppelt aufgeführt werden.
Mein Problem: Ich bekomme weder die Erstellung der Arbeitsblätter dynamisch nach Anzahl der Mitarbeiter noch die If Then Else Verteilung der Arbeiten dynamisch.



Sub EinfuegenMitarbeiter()



Dim blatt As Object

Dim BlattName As String

Dim bolFlg As Boolean



'** Blattname festlegen

BlattName = Tabelle4.Range("A2").Value

 

'** Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist

For Each blatt In Sheets

    If blatt.Name = Tabelle4.Range("A2").Value Then bolFlg = True           'True bedeutet der Tag wurde bereits gespeichert

    Next blatt

 

'** Blatt nur einfügen, wenn noch nicht vorhanden

If bolFlg = False Then

    With ThisWorkbook

        Sheets.Add After:=Sheets(Worksheets.Count)                          'Zählt wie viele Tabellenblääter und fügt es hiernach ein

        ActiveSheet.Name = Tabelle4.Range("A2").Value                       'Benennt das ausgewählte Blatt nach A" Hilfsliste

    End With

End If



End Sub



Public Sub AufgabenzettelMitarbeiterErstellen1()



    EinfuegenMitarbeiter                                        'Mitarbeiter Tabellenblatt anlegen

    Sheets("To_Do").Select                                      'Legt Startblatt fest

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

    For x = 2 To FinalRow

        ThisValue = Cells(x, 6).Value                           '6 gibt die Suchspalte an

        If ThisValue = Tabelle4.Range("A2").Value Then          'Überprüft Inhalt zwischen gefundenen Inhalt Spalte 6 und Hilfslisten Zelle

            Cells(x, 1).Resize(1, 33).Copy                      'Resize (1(wieviele Zeilen sollen kopiert werden, 33Wieviele Spalten kopiert werden)

            Sheets(Tabelle4.Range("A2").Value).Select           'Tabelle4... gibt die Zelle der Hilfsliste an nach der gesucht werden soll

            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

            Cells(NextRow, 1).Select

            ActiveSheet.Paste

            Sheets("To_Do").Select                              'Rückkehr zum Ursprungsblatt

        ElseIf ThisValue = Tabelle4.Range("A3").Value Then          'Überprüft Inhalt zwischen gefundenen Inhalt Spalte 6 und Hilfslisten Zelle

            Cells(x, 1).Resize(1, 33).Copy                      'Resize (1(wieviele Zeilen sollen kopiert werden, 33Wieviele Spalten kopiert werden)

            Sheets(Tabelle4.Range("A2").Value).Select           'Tabelle4... gibt die Zelle der Hilfsliste an nach der gesucht werden soll

            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

            Cells(NextRow, 1).Select

            ActiveSheet.Paste

            Sheets("To_Do").Select                              'Rückkehr zum Ursprungsblatt

        End If

    Next x

End Sub

Über Hilfe würde ich mich sehr freuen.
Viele Grüße
Karsten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub EinfuegenMitarbeiter() Dim blatt As Object Dim BlattName As String Dim bolFlg As Boolean '** Blattname festlegen BlattName = Tabelle4.Range("A2").Value '** Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist For Each blatt In Sheets 'du musst die Schleife verlassen, wenn true, sonst ist es beim nächten Blatt wieder false! If blatt.Name = Tabelle4.Range("A2").Value Then bolFlg = True 'True bedeutet der Tag wurde bereits gespeichert Exit For End If Next blatt '** Blatt nur einfügen, wenn noch nicht vorhanden If bolFlg = False Then With ThisWorkbook Sheets.Add After:=Sheets(Worksheets.Count) 'Zählt wie viele Tabellenblääter und fügt es hiernach ein ActiveSheet.Name = Tabelle4.Range("A2").Value 'Benennt das ausgewählte Blatt nach A" Hilfsliste End With End If End Sub

Public Sub AufgabenzettelMitarbeiterErstellen1() Dim einfüg_sh As Worksheet EinfuegenMitarbeiter 'Mitarbeiter Tabellenblatt anlegen Sheets("To_Do").Select 'Legt Startblatt fest Set einfüg_sh = Sheets(Tabelle4.Range("A2").Value) 'Legt Zielblatt fest FinalRow = Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To FinalRow ThisValue = Cells(x, 6).Value '6 gibt die Suchspalte an 'einfügezeile kann vorher festgelegt werden einfüg_z = einfüg_sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'freie Zeile in A If ThisValue = Tabelle4.Range("A2").Value Then 'Überprüft Inhalt zwischen gefundenen Inhalt Spalte 6 und Hilfslisten Zelle Range(Cells(x, 1), Cells(x, 33)).Copy einfüg_z.Cells(einfüg_z, 1) 'copy/paste ElseIf ThisValue = Tabelle4.Range("A3").Value Then 'Überprüft Inhalt zwischen gefundenen Inhalt Spalte 6 und Hilfslisten Zelle Range(Cells(x, 1), Cells(x, 33)).Copy einfüg_z.Cells(einfüg_z, 1) 'copy/paste End If Next x End Sub

Sub EinfuegenMitarbeiter(BlattName As String) Dim blatt As Object 'Dim BlattName As String Dim bolFlg As Boolean '** Blattname festlegen 'BlattName = Tabelle4.Range("A2").Value '** Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist For Each blatt In Sheets 'du musst die Schleife verlassen, wenn true, sonst ist es beim nächten Blatt wieder false! If blatt.Name = BlattName Then bolFlg = True 'True bedeutet der Tag wurde bereits gespeichert Exit For End If Next blatt '** Blatt nur einfügen, wenn noch nicht vorhanden If bolFlg = False Then With ThisWorkbook Sheets.Add After:=Sheets(Worksheets.Count) 'Zählt wie viele Tabellenblääter und fügt es hiernach ein ActiveSheet.Name = BlattName 'Benennt das ausgewählte Blatt nach A" Hilfsliste End With End If End Sub

Public Sub AufgabenzettelMitarbeiterErstellen1() Dim einfüg_sh As Worksheet For Each ma In Tabelle4.Range("A2:A" & Tabelle4.Range("A" & Rows.Count).End(xlUp).Row) EinfuegenMitarbeiter ma.Value 'Mitarbeiter Tabellenblatt anlegen Sheets("To_Do").Select 'Legt Startblatt fest Set einfüg_sh = Sheets(ma.Value) 'Legt Zielblatt fest FinalRow = Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To FinalRow ThisValue = Cells(x, 6).Value '6 gibt die Suchspalte an 'einfügezeile kann vorher festgelegt werden einfüg_z = einfüg_sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'freie Zeile in A If ThisValue = ma.Value Then 'Überprüft Inhalt zwischen gefundenen Inhalt Spalte 6 und Hilfslisten Zelle Range(Cells(x, 1), Cells(x, 33)).Copy einfüg_z.Cells(einfüg_z, 1) 'copy/paste ElseIf ThisValue = ma.Offset(1, 0).Value Then 'Überprüft Inhalt zwischen gefundenen Inhalt Spalte 6 und Hilfslisten Zelle Range(Cells(x, 1), Cells(x, 33)).Copy einfüg_z.Cells(einfüg_z, 1) 'copy/paste End If Next x Next ma End Sub

Beliebteste Forumthreads (12 Monate)

Dynmaische Erweiterung If Then Else und Blatterstellung

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dynmaische Erweiterung If Then Else und Blatterstellung

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread