Erstellung eines Makros

Hallo, ich habe keine Kenntnisse in VBA und hoffe auf HILFE.
Was will ich?
Ich habe eine größere Datei und möchte noch etwas automatisieren. Dazu würde ich ein Makro als Muster benötigen. Dies würde ich dann selbst so verändern/anpassen, dass es für mich verwendbar wird.
In diesem Makro sollte folgender Schritt beschrieben werden:
Wenn im Arbeitsblatt Name in D3 = A steht, dann aus dem Arbeitsblatt Dienstzyklus die Zeile B6 bis AF6 in das Arbeitsblatt 1 in B18 bis AF18 kopieren, wenn nicht dann nichts.
Wenn im Arbeitsblatt Name in D3 = B steht, dann aus dem Arbeitsblatt Dienstzyklus die Zeile B8 bis AF8 in das Arbeitsblatt 1 in B18 bis AF18 kopieren, wenn nicht dann nichts.
Wenn im Arbeitsblatt Name in D3 = C steht, dann aus dem Arbeitsblatt Dienstzyklus die Zeile B10 bis AF10 in das Arbeitsblatt 1 in B18 bis AF18 kopieren, wenn nicht dann nichts.
Wenn im Arbeitsblatt Name in D3 = D steht, dann aus dem Arbeitsblatt Dienstzyklus die Zeile B12 bis AF12 in das Arbeitsblatt 1 in B18 bis AF18 kopieren, wenn nicht dann nichts.
Wenn im Arbeitsblatt Name in D3 = E steht, dann aus dem Arbeitsblatt Dienstzyklus die Zeile B14 bis AF14 in das Arbeitsblatt 1 in B18 bis AF18 kopieren, wenn nicht dann nichts.
Wenn Arbeitsblatt Name in D3 = "" steht - dann nichts eintragen.
Wenn für ein besseres Verständnis die Datei benötigt wird könnte ich sie auch Hochladen.
Danke im Voraus, Stockl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Guten Morgen,
und entschuldige, aber ich hatte geschrieben, dass ich fast keine Ahnung vom VBA habe.
Danke für den Vorschlag. Ich habe ihn mit dem vom Nepumuk verglichen und sah, dass es für mich nicht nachvollziehbar war. Ich war hier stecken geblieben.
For Each ws In ThisWorkbook.Worksheets
If ws.Name = CStr(Month(Date)) Then
With ws
boVorhanden = True
Kann es aber auch nicht lesen. Für mich fehlte der Bezug wo die Daten herkommen Dienstzyklus. Der Rest konnte ich nachvollziehen.
Für mich war das von Nepumuk überschaubarer.
Ich hatte schon in ein anderes Forum gefragt und bekam keine Antwort. Diese Anfrage hatte ich zur Ansicht hochgeladen unter:
https://www.herber.de/bbs/user/142788.doc
Ich wollte auch mein Projekt laden aber es ist zu groß (knapp 9MB).
Vielleicht noch einmal zur Erklärung:
Die Arbeitsmappe besteht aus knapp 200 Arbeitsblätter.
Davon sind 170 Arbeitsblätter (grün markiert von 1-170) im Bild sind davon 30 Arbeitsblätter zusehen. Das sind die Dienstpläne der einzelnen Kollegen welche in verschiedenen Schichten arbeiten.
Dann gibt es das Arbeitsblatt Namen, da sind alle Kollegen erfasst, einer Dienstschicht (A-E) und dem persönlichen Dienstplan (1-170) zugeordnet.
Dann gibt es das Arbeitsblatt Dienstzyklus darin ist der Jahres-Dienstplan beschrieben (monatlich, in 12 Tabellen).
Mein Ziel ist es:
Wenn Arbeitsblatt Name in D3 = A steht dann aus Dienstzyklus die Zeile B6 bis AF6 in das Arbeitsblatt 1 in B18 bis AF18 kopieren, wenn nicht dann nichts.
D3 = erste Zuordnung und D172 = die letzte Zuordnung
Somit bin ich mit dem Vorschlag von Nepumuk
With ThisWorkbook.Worksheets("Dienstzyklus")
besser zurechtgekommen weil ich den Verweis auf Dienstzyklus gefunden habe.
Dann ist mein Ansinnen das Makro von D3 zu kopieren bis D172 und dann laufen zu lassen damit alle Dienstpläne beschrieben werden.
Gruß Stockl

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "D3" Then Select Case Target.Value Case "A" Worksheets("1").Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B6:AF6"). _ Value Case "B" Worksheets("1").Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B8:AF8"). _ Value Case "C" Worksheets("1").Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B10:AF10") _ .Value Case "D" Worksheets("1").Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B12:AF12") _ .Value Case "E" Worksheets("1").Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B14:AF14") _ .Value Case "" Worksheets("1").Range("B8:AF8") = "" Case Else End Select End If End Sub

Public Sub Schicht() Dim ws As Worksheet, boVorhanden As Boolean For Each ws In ThisWorkbook.Worksheets If ws.Name = CStr(Month(Date)) Then With ws boVorhanden = True Select Case Worksheets("Name").Range("D3").Value Case "A" .Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B6:AF6").Value Case "B" .Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B8:AF8").Value Case "C" .Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B10:AF10").Value Case "D" .Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B12:AF12").Value Case "E" .Range("B8:AF8").Value = Worksheets("Dienstzyklus").Range("B14:AF14").Value Case "" .Range("B8:AF8") = "" Case Else End Select Exit For End With End If Next ws If Not boVorhanden Then MsgBox "Fehler: Das Tabellenblatt für den aktuellen Monat existiert nicht." & vbLf & vbLf _ & "Bitte das Blatt erst anlegen." End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim x If Target.Address = "$D$3" Then Range("B18").Resize(, 31).ClearContents x = InStr(" ABCDE", Target) If x 0 Then Sheets("Dienstplan").Cells(x * 2, 2).Resize(, 31).Copy Sheets("1").Range("B18") End If End If End Sub

Sub kopieren() Dim lRow As Long, lRow2 As Long Application.ScreenUpdating = False With Sheets("Namen") For lRow = 3 To .Cells(Rows.Count, 2).End(xlUp).Row Select Case .Cells(lRow, 4) Case "A": lRow2 = 6 Case "B": lRow2 = 8 Case "C": lRow2 = 10 Case "D": lRow2 = 12 Case "E": lRow2 = 14 Case Else: lRow2 = 0 End Select If lRow2 0 Then Sheets("Dienstzyklus").Cells(lRow2, 2).Resize(, 2).Copy Sheets(.Cells(lRow, 1)).Cells( _ 18, 2) End If Next lRow End With End Sub

Beliebteste Forumthreads (12 Monate)

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread