Autom. Übernahme von Daten unterschiedliche Tabellenblätter

Hallo,

ich bin Anfägerin in VBA und weiß daher nicht genau ob meine Anfrage ggf. schon in einem Thread behandelt wurde, aber ich konnte Anhand meiner Suche nichts finden. (Vermutlich da mir die Fachbegriffe fehlen)

Um nicht in jedem Jahr aufs neue 300 Personaldatensätze neu eingeben zu müssen würde ich mir gern eine Excel anlegen die dies für mich übernimmt.

In Tabellenblatt 1 sollen die Datensätze des Personalstammes aus den letzten Jahren stehen und in der letzten Spalte das Jahr in dem die Person das letzte mal eingesetzt wurde. (Dies habe ich soweit erstellen können)

Jetzt zu meiner Frage:

Gibt es die Möglichkeit in Tabellenblatt 2 einen Button einzufügen der mir automatisch die Daten der Personen einfügt und aktualisiert bei denen in Tabellenblatt 1 das aktuelle Jahr steht?

Meine bisher erstellte Arbeitsmappe habe ich einmal angehängt.

https://www.herber.de/bbs/user/162173.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

So geht das

04.08.2023 10:54:28

Klexy

So geht das

04.08.2023 11:02:47

Michele

Sub Personal_aktuell_transferieren()

Dim Spalte_letztes_Fest As Integer, Markierung As Range, m As Range, Datensatz As Range

Dim Spalte_Name As Integer, Zeile_Name As Integer

    Sheets("Stammdaten").Select

    Spalte_letztes_Fest = Cells.Find(What:="letztes Fest", After:=Range("A1"), LookIn:=xlFormulas, _

        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

        MatchCase:=False, SearchFormat:=False).Column

    Set Markierung = Intersect(ActiveSheet.UsedRange, Cells(1, Spalte_letztes_Fest).EntireColumn)

    ' Markierung.Select

    For Each m In Markierung

        ' m.Select

        If m = Year(Date) Then

            Set Datensatz = Range(Cells(m.Row, 2), Cells(m.Row, Spalte_letztes_Fest - 1))

            ' Datensatz.Select

            Datensatz.Copy

            Sheets("Team 2023").Select

            Spalte_Name = Cells.Find(What:="Name", After:=Range("A1"), LookIn:=xlFormulas, _

                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

                MatchCase:=False, SearchFormat:=False).Column

            Zeile_Name = Cells.Find(What:="Name", After:=Range("A1"), LookIn:=xlFormulas, _

                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

                MatchCase:=False, SearchFormat:=False).Row

            If Cells(Zeile_Name, Spalte_Name).Offset(1, 0) = "" Then

                Cells(Zeile_Name, Spalte_Name).Offset(1, 0).PasteSpecial Paste:=xlValues

            Else

                Cells(Zeile_Name, Spalte_Name).End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlValues

            End If

            Sheets("Stammdaten").Select

        End If

    Next m

    Sheets("Team 2023").Select

End Sub

Nächstes Jahr musst du die entsprechenden Namen anpassen (2023 --> 2024)!
Und ich empfehle, keine dekorativen Leerzeilen über der Kopfzeile zu lassen. Unnötig und verkompliziert Lösungen.

Beliebteste Forumthreads (12 Monate)

Autom. Übernahme von Daten unterschiedliche Tabellenblätter

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Autom. Übernahme von Daten unterschiedliche Tabellenblätter

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread