Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Zellinhalte automatisch auf anderes Blatt kopieren





Frage

Mein Problem sieht folgendermaßen aus: In einer Gesamtübersicht steuert jeder MA über Makros seinen Urlaub ein. Diese Eingaben sollen automatisch auch in seinem "persönlichen" Tabellenblatt eingetragen werden. MIt Verknüpfung geht es nicht, da in der Gesamtübersicht jeder MA eine Spalte hat und auf den einzelnen Tabellen die Monate in Zeilen stehen. Zudem sind alle Zellen wegen der Wochenenden und Feiertage bedingt formatiert. Ich will jetzt nicht für jede Zelle einen WENN-Verweis eintragen, das wären 365 mal 12 (MA) Einträge! Kann ich das mithilfe eines Makros lösen, sodass bei einer Eingabe auf der Gesamtübersicht (Text und Hintergrundfarbe) dieses auch in den einzelnen Tabellenblättern geschieht? Bei der WENN-Funktion wurde nämlich auch nur der Inhalt und nicht das Format übertragen. Ich hoffe, ich konnte die Situation so erklären, dass sie für einen Außenstehenden verständlich ist. Schon einmal vielen Dank für die Hilfe!

Antwort 1 von piano

Hallo Henni
schick mir einen einen kleinen relevanten Auszug Deiner Mappe an piano1244@hotmail.com.
Gruß piano

Antwort 2 von piano

Hallo Henni
Die Lösung ist relativ einfach, wenn wir davon ausgehen, dass die Mitarbeiter-Spalten der Tabelle "Gesamtübersicht" in der selben Reihenfolge wie die zugehörigen Blätter aufliegen. Eine Fehlermeldung gibt es, wenn nicht alle Blätter vorhanden sind.
Der Makro arbeitet immer alle Mitarbeiter auf einmal ab. Wenn das nicht erwünscht ist, könnte man natürlich auch durch einfache Modifikation einen einzelnen MA auswählen:
 Sub Übertrag()
Dim i As Integer, MName, Msheet, AnzahlMA, AnzahlSheets
AnzahlSheets = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
    Sheets(1).Select
    AnzahlMA = ActiveSheet.UsedRange.Columns.Count
    For i = 2 To AnzahlMA
        Msheet = i  ´Nummer des Mitarbeiter-sheets
        If Msheet > AnzahlSheets Then
            MsgBox ("Mitarbeitertabelle??")
            Exit For
        End If
        ´Sheets(Msheet).Activate
        Aufteilen (Msheet)
    Next i
    Sheets(1).Activate
Application.ScreenUpdating = True

End Sub

Public Function Aufteilen(Msheet)
Dim i As Integer, Wert, Farbe, Tag, Monat, ZielZeile, ZielSpalte
    For i = 10 To 375
        Farbe = Sheets(1).Cells(i, Msheet).Interior.ColorIndex
        Wert = Sheets(1).Cells(i, Msheet).Value
        Sheets(1).Cells(i, Msheet).Copy
        Tag = Day(Sheets(1).Cells(i, 1))
        Monat = Month(Sheets(1).Cells(i, 1))
        ZielSpalte = 4 + Monat
        ZielZeile = 2 + Tag
        Sheets(Msheet).Cells(ZielSpalte, ZielZeile).Value = Wert
        Sheets(Msheet).Cells(ZielSpalte, ZielZeile).Interior.ColorIndex = Farbe
    Next i
End Function


Gruß piano

Es wäre nett, wenn Du ein Feedback abgeben könntest,
ob der Lösungsvorschlag Dein Problem gelöst hat.